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1.  INTRODUCTION 


For  experimental  studies  of  target  response  to  high  energy  blast,  one 
needs  an  accurate  definition  of  the  blast  field  which  provides  the  load  on  the 
target.  Direct  measurements  of  the  flow  field  usually  are  restricted,  for 
technical  reasons,  to  pressure  history  observations,  and  to  shock  arrival  time 
and  incident  shock  pressure  measurements  at  various  stations.  Hence,  one  has 
to  compute  other  flow  variables,  e.g.,  the  density  and  the  particle  velocity, 
from  the  measured  pressures.  The  problem  can  be  formulated  as  a  task  to  solve 
numerically  the  governing  equations  of  the  flow  field  with  boundary  conditions 
derived  from  pressure  history  and  shock  observations. 

In  this  formulation,  the  task  is  a  mathematically  ill-posed  problem 
because  the  boundary  conditions  overdetermine  the  solution  in  some  parts  of 
the  flow  field,  and  at  the  same  time  may  not  be  sufficient  to  compute  the 
complete  flow  history  for  the  full  duration  of  a  pressure  history  observation 
at  some  other  station. 

A  possible  regularization  of  the  problem  is  described  in  Reference  1.  It 
consists  of  deleting  one  of  the  flow  governing  equations,  solving  the  ensuing 
well-posed  problem  numerically,  and  using  the  deleted  equation  later  for 
control  calculations.  The  calculation  starts  by  first  determining  a  pressure 
field  function  p^(r,t)  within  a  region  of  interest.  The  function  is  found  by 

a  least  squares  model  fitting,  and  substituted  into  the  governing  equations 
which  in  turn  determine  the  other  flow  variables.  Problems  of  this  type  were 
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considered  by  Makino  who  observed  that  one  does  not  need  the  continuity 
equation  for  the  flow  calculation  if  p^(r,t)  is  known.  Following  Makino' s 

theoretical  ideas,  we  have  established  computer  programs  that  compute  the  flow 
in  the  aforementioned  manner  using  the  continuity  equation  at  the  end  of  the 
calculations  to  check  the  accuracy  of  the  results.  Reference  1  also  contains 
an  analysis  of  the  sensitivity  of  the  results  to  observational  inaccuracies. 
The  calculation  of  corresponding  accuracy  estimates  of  the  results  is  included 
in  the  computer  programs. 

The  present  manual  describes  the  structure  of  the  programs  and  specifies 
the  input  requirements.  The  basic  theory  is  described  in  Section  2,  and 
Sections  3  and  4  provide  an  outline  of  the  solution  method.  A  more  detailed 
description  of  the  method  is  given  in  Reference  1.  The  computer  program  for 
the  solution  consists  of  three  independent  parts,  BLAFS,  BLAPOP  AND  BLAFHI , 
which  are  described  in  Sections  5,  6  and  7,  respectively.  Section  8  contains 
descriptions  of  all  subroutines  that  are  included  in  the  three  programs  in 
alphabetical  order.  The  programs  .ire  listed  in  Appendices  A,  B  and  C. 

Users  at  the  Ballistic  Research  Laboratory  may  contact  the  author  about 
access  for  the  latest  versions  of  the  programs. 


1.  Aivars  CelmipS,  "Reconstruction  of  a  Blast  Field  from  Pressure  History 
Observations,"  ARBRL-TR-02367,  September  1981  (AD-A106141) . 

2.  Ray  C.  Makino,  "An  Approximation  Method  in  Blast  Calculations," 
BRL-MR-1023,  February  1956  (AD-114  875). 


2.  BASIC  ASSUMPTIONS  AND  THEORY 


We  seek  to  determine  certain  parts  of  the  flow  field  within  a  blast 
bubble  in  air.  The  area  of  interest  is  a  relatively  narrow  strip  in  the 
r,t-plane  behind  the  initial  shock  trajectory  at  a  distance  where  the  shock 
strength  is  only  moderate.  We  shall  assume  that  the  following  conditions  are 
satisfied  within  the  area  of  interest: 


(A)  the  flowing  medium  is  an  ideal  gas  with  zero  viscosity  and  no 
heat  conduction,  and 

(B)  the  event  is  spherically  symmetric  and  the  flow  has  only  a  radial 
velocity  component  u. 


The  first  assumption  is  satisfied  in  most  applications  because  typically 
the  maximum  overpressure  at  the  target  is  only  of  the  order  of  one  megapascal. 
Within  this  pressure  regime  air  behaves  like  an  ideal  gas.  The  second  con¬ 
dition  is  nearly  satisfied  in  most  experiments,  because  usually  the  explosion 
source  and  the  targets  are  positioned  on  the  same  plane,  and  the  blast  bubble 
is  a  hemisphere.  Deviations  from  spherical  flow  symmetry  within  the  bubble 
may  be  caused  by  local  surface  disturbances,  by  wind,  and  by  the  presence  of 
dust  in  the  flow  near  the  ground  surface.  The  present  technique  cannot  be 
applied  to  cases  where  such  disturbances  are  not  negligible. 


The  governing  equations  for  a  flow  satisfying  the  conditions  (A)  are:3 


+  p  div  u  =  0, 
at 

(2.1) 

/du 

P—  +  grad  p  ■  0 

(2.2) 

and 

E  dP  =  Q 

dt  p  dt  0 ' 

(2.3) 

in  which 

d  a 

dt  =  at  +  (u  •  «rad) 

(2.4) 

is  the  material  derivative.  The  equation  of  state  is 


where  Y  is  the  ratio  of  specific  heats. 


(2.5) 


Eliminating  the  specific  internal  energy  e  between  Equations  2.3  and  2.5 
one  obtains 


I  ?£.,I 

P  dt  P 


(2.6) 


3.  Richard  von  Mises,  "Mathematical  Theory  of  Compressible  Fluid  Flow," 
Acadenic  Press,  NY,  1958. 


Equation  2.6  can  oe  integrated  along  a  particle  path  line.  The  result  is  the 
well  known  formula  for  a  particle  in  an  adiabatic  flow: 


4'fcf 


wnere  the  subscript  A  indicates  reference  values  at  a  point  A  on  the  particle 
pQtn  • 


Tne  momentum  Equation  2.2  can  be  reformulated  by  substituting  in  it  tne 
expression  given  in  Equation  2.7.  The  result  is 


If  tne  pressure  function  p(r,t)  is  given,  e.g.,  by  measurements,  then  Equation 
2.o  can  be  numerically  integrated  together  with  the  path  line  equation 


Tne  integration  provides  the  path  line  starting  at  a  point  A  and  the  particle 
velocity  along  it.  Tne  density  along  the  same  path  line  is  given  by  Equation 
2.1.  Ail  other  flow  variables,  such  as,  internal  energy,  dynamic  pressure, 
and  souna  speed  can  be  computed  from  p,  u,  and  p. 

The  continuity  Equation  2.1  is  not  needed  for  the  described  calculation 
of  the  flow  corresponding  to  an  observed  pressure  field  p(r,t).  Therefore, 
one  can  use  the  equation  to  test  the  calculated  results,  as  suggested  by 
2 

Makino.  In  fact,  if  the  pressure  p(r,t)  is  measured  precisely  then  this  test 
provides  a  cneck  of  the  validity  of  the  assumptions  (A)  and  (3)  about  the  flow 
field.  In  praxis,  test  calculations  based  on  the  continuity  equation  cannot 
provide  exactly  the  same  result  as  the  integration  along  path  lines  because 
tne  pressure  field  function  p(r,t)  on  the  right-hand  side  of  Equation  2.6  is 
an  approximation  containing  observational  and  systematic  errors.  The  effects 
ot  the  former  are  estimated  in  our  approach  from  input  information  about  tne 
uate  accuracy.  Systematic  errors  may  manifest  themselves  by  differences 
oetween  original  and  control  calculations  that  are  larger  than  predicted  by 
the  estimated  propagation  of  the  observational  errors. 

A  control  calculation  based  on  the  continuity  equation  can  be  carric-u  out 
as  follows.  First,  we  use  Equation  2.0  and  reformulate  the  continuity 
Equation  2.1,  obtaining 


div  u  +  — 

yp 


d£ 

dt 


0, 


(2.10) 


or 


_9_ 

3r 


(r2u)  +  (r2u) 


1_ 

yp 


+  ll  3R 

3r  yp  3t 


0. 


(2.11) 
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Equation  2.11  expresses  the  dependence  of  the  quantity  r  u  on  r  for  t  =  const. 
A  formal  integration  of  the  equation  along  a  line  t  =  const,  yields 


(2.12) 


r27p(r,t)1/Y 


|2  '  P(£,t)1/v  d£ 


The  subscript  C  in  Equation  2.12  indicates  function  values  at  a  point  C  with 
the  coordinates  (rc,t).  Using  Equation  2.12  one  can  calculate  the  particle 

velocity  u(r,t)  by  a  numerical  quadrature  along  t  =  const.,  if  an  initial 
value  uc  and  the  pressure  field  function  p(r,t)  are  known. 

In  summary,  we  proceed  as  follows  for  the  calculation  of  the  flow  field. 
First,  we  establish  a  pressure  field  function  p(r,t)  by  data  fitting.  Next, 
we  integrate  Equations  2.8  and  2.9  along  a  particle  path  A^B^,  as  shown  in 

Figure  1.  The  integration  produces  the  velocity  u^  at  B^.  The  density  P B  can 

be  computed  using  Equation  2.7,  once  the  path  line  is  established.  (The  flow 
variables  uft  and  p^  on  the  shock  are  known  from  the  pressure  field  function 

and  shock  relations.)  Finally,  the  calculated  velocity  uD  is  compared  with 

D 

another  calculation  using  Equation  2.12,  applied  along  the  line  CB^.  The 
velocity  uc  at  the  point  C  is  again  obtained  from  shock  relations. 

The  overpressure  field  function  is  determined  within  the  indicated  domain 
from  pressure  history  measurements  along  the  lines  AA^,  BB^  and  CC^,  and  from 

shock  observations.  The  flow  history  at  r=r_  can  be  calculated  between  B  and 

B 

B_,  and  test  calculations  by  Equation  2.12  can  be  carried  out  between  B  and  B  . 
^  1 

3.  NUMERICAL  IOTEGRATION  AND  ACCURACY  ESTIMATES 

In  most  applications,  one  needs  the  flew  history  at  some  fixed  distance, 
say  rD.  We  obtain  the  history,  i.e.,  the  values  of  flow  variables  at  a  series 

of  points  along  the  line  r  =  rD  in  Figure  1,  by  integrating  Equations  2.8  and 

2.9  along  a  number  of  path  lines,  each  starting  at  a  different  point  of  the 
shock.  The  test  calculation  of  the  velocity  is  done  by  integration  of 
Equation  2.12  along  appropriate  lines  t  =  const.  Figure  1  schematically  shows 
the  integration  lines  and  the  locations  of  the  computed  nodes  in  the 
r,t-plane.  The  values  of  the  flow  variables  at  the  shock  as  well  as  the 
pressure  field  function  behind  the  shock  that  are  needed  for  these 
integrations,  are  obtained  by  model  fitting  of  shock  and  pressure  observations 
respectively. 

The  results  of  the  shock  model  fitting  are  two  functions  of  the  radial 
distance  r  and  of  a  model  parameter  vector  9  describing  the  shock  arrival  time 
t  ( r;0 )  and  the  shock  overpressure  p  (r;0)  respectively.  The  shock  density  P 
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Figure  1.  Computation  of  Flow  History  at  a  Given  Distance. 

The  overpressure  field  function  is  determined  within  the  indicated 
domain  from  pressure  history  measurements  along  the  lines  AA^, 

BB3>  and  CC3,  and  from  shock  observations.  For  r  =  rR,  the  flow 

history  can  be  calculated  between  B  and  B  ,  and  test  calculations 

can  be  carried  out  between  B  and  B^. 
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and  particle  velocity  u  behind  the  shock  follow  from  these  functions  and 

o 

shock  relations.  The  model  fitting  of  the  observed  pressure  histories 
produces  an  overpressure  field  function  Pf(r,t;0).  (See  Section  4.) 

The  differential  equations  for  the  path  line.  Equations  2.8  and  2.9  are 
in  terms  of  these  functions: 

dr 

dt  "  u’ 

du  (5-1) 

5t  =  F(r>t;0) 


where 


F (r ,t; 6) 


P^. 


_1 _ 

(r ; 0) 

A 


1/Y 

,PS(rA;9)+Po  V 

pf (r,t;0)+poy 


3pf (r,t;6) 
3r 


(3.2) 


and  pq  is  the  ambient  pressure.  We  integrate  Equation  3.1  using  a  fourth 
order  predictor-corrector  algorithm. 


The  control  calculation  by  Equation  2.12  is  carried  out  by  substituting 
Ps  and  pf  in  it  and  then  calculating  the  integral  with  a  Romberg  quadrature 

routine. 


The  accuracy  of  the  computed  results  depends  on  the  accuracies  of  the 
integration  algorithms  as  well  as  on  the  accuracies  of  the  data  that  are  used 
to  determine  the  pressure  functions  pg  and  pf.  The  pure  integration  errors 

can  be  reduced  to  desired  levels  by  monitoring  the  integration  step  sizes. 

The  errors  due  to  data  inaccuracies  are  estimated  using  the  linearized  law  of 
variance  propagation  as  described  below. 

4 

The  least  squares  data  fitting  programs  provide  an  estimate  of  the 
variance-covariance  matrix  V$  of  the  parameter  vector  0  in  terms  of  the 
estimated  standard  errors  of  the  observations.  An  estimate  of  the  standard 
error  of  a  function  of  0,  e.g.,  of  p^(r,t;5)  is  given  by 


The  standard  error  of  p  (r;4)  can  be  calculated  by  a  corresponding  formula, 

s 

and  the  standard  error  of  p  can  be  calculated  by  using  the  relation 
between  density  and  pressure  given  in  Equation  2.7. 

The  standard  error  of  the  particle  velocity  can  be  calculated  in  the  same 
manner  provided  that  one  knows  the  derivative  vector  8u/d0 .  Unlike  dP^/dd  » 


4.  Aivars  Celmii)?,  "A  Manual  for  General  Least  Squares  Model  Fitting," 
ARBRL-TR-02167,  June  1979  (AD-B040229L) . 
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that  vector  cannot  be  obtained  by  a  formal  differentiation  because  u  is  not 
given  by  a  formula  but  obtained  by  solving  numerically  the  equation  systen 
3.1.  Therefore,  we  differentiate  that  system  with  respect  to  the  parameter 
and  obtain  another  system  of  differential  equations  where  the  unknown 
functions  are  the  derivatives  du/90  and  gr/30 .  The  new  system  is 

_d  (l u\  3F  +  3F  3r 

at  yae j  30  3*  36 

A.  /3r\  _  3u  (3-4) 

at  ^30 J  as  * 

The  equations  are  integrated  numerically  concurrently  with  the  path  line 
Equations  3.1. 

The  end  point  of  each  path  line  has  an  uncertainty  in  the  t-direction 
which  again  can  be  computed  by  the  variance  propagation  formula  using  the 
derivatives 


(3.5) 


2 

For  the  computation  of  the  standard  error  of  the  dynamic  pressure  p  u  /2 
one  needs  to  know  the  variances  as  well  as  the  covariance  of  p  and  u.  The 
full  variance-covariance  matrix  of  the  flow  field  at  an  end  point  of  a  path 
line  is  calculated  with  the  formula 

T 

(3.6) 


where 


H 


^tB'  PB'  “b'  P  b) 


(3.7) 


is  a  vector  that  characterizes  the  flow  field.  VH  contains  the  covariance 

between  velocity  and  density  that  is  needed  for  the  dynamic  pressure  error 
estimate. 


4.  OVERPRESSURE  MODEL  FITTING 

The  shock  overpressure  is  modeled  by  the  following  three-parameter 
function 

2  3 

ps(r;a,b,c)  =  a/r  +  b/r  +  c/r  , 

and  the  shock  arrival  time  is  modeled  by  the  four  parameter  function 


(4.1) 


where  cq  is  the  ambient  sound  speed  and  rQ  is  an  arbitrary  reference  distance. 
The  overpressure  field  function  is  modeled  by  the  five  parameter  model 


pf(r,t;  vwww  ~ 


[■>.  -cA”c]  *  4nr- 


,  (4.3) 


where 


V1  =  [t-tg]  <VA2r^  A  f  [t_ts]  (ai+d2 r]/r 


In  these  equations,  the  exponents  n^,  nB,  and  nc  are  determined  by  an  analysis 

of  the  trends  of  the  observed  pressure  histories.  Therefore,  the  total  number 
of  free  parameters  for  both  model  fittings  is  nine,  the  four  shock  parameters, 
a  through  d,  and  the  five  parameters,  A^  through  C^. 

The  model  fitting  is  done  in  two  stages  using  utility  programs  from 
Reference  4.  In  the  first  stage,  one  determines  the  shock  functions  pg  and 

tg.  The  second  stage  provides  the  overpressure  field  function  p^.  The  data 

for  the  model  fittings  are  measurements  of  overpressures,  times,  and  distances 
with  corresponding  accuracy  estimates.  In  the  second  stage  one  also  uses  as 
input  the  results  of  the  first  stage,  namely,  the  shock  parameters  a,b,c,d  and 
their  accuracy  estimates. 

The  two  adjustment  stages  are  programmed  as  two  independent  program 
packages,  BLAFS  and  BLAFOP.  A  third  package,  BIAFHI,  uses  the  results  of  the 
first  two  (essentially,  the  nine  pressure  field  parameters  with  accuracy 
estimates)  and  carries  out  the  integrations  described  in  Section  3.  Instruc¬ 
tions  for  the  use  of  the  three  program  packages  are  given  in  Sections  5,  6, 
and  7,  respectively. 


5.  SHOCK  FITTING  PROGRAM  BLAFS 
5.1  Purpose  of  the  Program. 


The  purpose  of  the  program  is  to  determine  from  measurements  of  shock 
arrival  times,  distances  and  overpressures  a  shock  overpressure  model  function 


2  3 

Ps  (r;  a,b,c)  =  a/r  +  b/r  +  c/r 
and  a  shock  arrival  time  model  function 


tg  (r;  a,b,c,d)  =  d  + 


f  _ * _ 

J  c  f  1  +  1  (a/x  +  b/x2  +  c/x3) 


(5.1) 


(5.2) 


In  tnese  equations  rQ  is  an  aroitrary  reference  distance,  cq  is  the  ambient 

sound  speed,  pQ  is  the  ambient  pressure,  and  y  is  the  ratio  of  specific  neats 

of  tne  ambient  air.  These  four  quantities  are  part  of  the  input  for  tne 
program,  in  addition  to  tne  shock  measurements.  The  program  calculates  least 
squares  values  of  the  four  shock  model  parameters  a,  b,  c  ano  and  previous 
estimates  of  their  variances  ana  covariances.  A  program  listing  with  comments 
is  given  m  Appendix  A,  ana  the  subroutines  of  the  program  are  described  in 
Section  ti. 


5.2  input  for  tne  dnock  Fitting  Program 

Tne  input  consists  of  two  parts:  general  data  describing  the  ambient  air 
and  the  cnarge,  and  shock  ooservations. 

The  general  oata  are  proviaea  by  three  mandatory  and  three  optional 
earns.  The  end  of  tne  general  data  batch  is  indicated  by  a  blank  cara.  The 
first  two  manaatory  earns  nave  the  format  (BA1U)  and  the  third  card  has  the 
format  (2A1U,  Uulu.J).  The  contents  of  the  manaatory  cards  are  as  follows: 


1  11 

TITLE  30  character  title 


1  11 

PLOTLABEL  40  character  plotting  label 


|1  **  121 

I  CHARGE  |V,  E,  H,  eu. 

M 


The  TITLE  card  contains  the  identification  of  the  computer  run.  The 
identification  will  appear  on  all  printed  end  plotted  output. 

The  PLOTLABEL  card  contains  the  identification  for  the  Calcomp  plotter 
output.  It  will  not  appear  on  individual  plots. 

The  CHAK3E  cara  contains  a  description  of  the  charge  by  the  following 
parameters: 

y  =  volume  of  tne  Lire  ball,  m\ 

E  =  released  energy,  J, 

H  =  height  of  Durst,  m, 
e j  =  standard  error  of  H,  m. 

The  values  of  V  and  E  are  only  needed  to  scale  the  event,  and  they  do 
not  affect  any  otner  results  of  the  calculations.  If  scaling  is  not  of 
interest,  then  arbitrary  or  nominal  values  of  V  and  E  may  be  entered. 

However,  V  must  oe  positive.  The  height  H  corresponds  to  the  center  of  the 
fire  bail.  It  snouid  oe  small  compared  to  the  distance  petwe^n  the  center  of 
the  explosion  and  the  locations  of  the  pressure  gages  in  order  not  to  violate 
the  assumption  of  a  spherical  symmetry  of  the  flow  field. 
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The  three  optional  cards  have  the  same  format  as  the  CHARGE  card,  namely 
(2A10,  6E10.3),  and  they  may  be  entered  in  arbitrary  sequence  after  the  first 
two  or  three  mandatory  cards.  The  cards  have  the  following  contents: 


1 

I21 

AMBIENT 

1*0'  V 

y 

1 

1  21 

SCALES 

1  V  V 

s 

p 

1 

I21 

PLOTTING 

DATA  If  , 

f . 

The  AMBIENT  card  specifies  the  ambient  air  as  follows: 
pQ  =  ambient  pressure.  Pa  (101325.0) 

Tq  =  ambient  temperature,  K  (293.0) 
y  =  ratio  of  specific  heats  (1.4) 

M  =  molar  mass,  kg/mol  (0.02896)  . 

If  this  card  is  missing,  or  if  an  input  value  is  not  positive,  then  the 
missing  or  faulty  value  is  replaced  by  the  corresponding  default  value  shown 
in  parentheses.  The  input  must  be  expressed  in  base  SI  units,  as  indicated. 

The  SCALE  card  allows  one  to  carry  out  the  calculations  in  arbitrary 
scales.  The  specified  scales  are: 

sr  =  distance  scale,  m 

Sp  =  pressure  scale.  Pa 

sfc  =  time  scale,  s. 

If  the  SCALE  card  is  missing  or  if  any  of  the  scales  is  not  positive  then  the 
following  default  scales  will  be  used: 


=  . 


sp  *  po  • 

st  *  W 

where  cQ  is  the  ambient  sound  speed,  computed  with  the  formula 
cQ  =  (  TqR/M)1/2 

with  the  universal  gas  constant  R  =  8.3143  J/(K  x  mol).  The  scales  s^ ,  Sp, 
and  sfc  are  also  used  for  the  output.  Therefore  the  SCALE  card  permits  one  to 
obtain  the  output  in  non-standard  scales,  if  desired.  If  the  output  is  to  be 


in  base  31  units  then  unit  scales  s„  =  s  =  s^  =  1  must  be  specified.  The 

r  p  t 

numerical  performance  of  the  program  is  little  influenced  by  the  scaling. 

The  PLOTTING  DATA  care  contains  error  factors  for  tne  plotting  of  confl¬ 
uence  limits: 


f  =  error  factor  for  confidence  limits  in  pressure  plots, 
f  =  error  factor  for  confidence  limits  in  all  otner  plots. 


Tne  plotted  confidence  limits  will  correspond  to  f  and  f  standard  errors, 

respectively.  If  tne  card  is  missing  then  the  default  values  f  =  f  =  z.u  are 

used.  If  a  factor  is  zero  then  corresponding  confidence  limits  will  not  be 
plotted. 


The  end  of  tne  general  data  is  indicated  by  a  blank  card.  It  is  followed 
oy  cards  containing  snock  data.  All  shock  data  caras  nave  the  format  (2A1U, 
6Elu.3)  and  their  sequence  is  arbitrary.  Each  snock  point  is  represented  Dy 
two  cards  with  identical  labels.  The  two  cards  contain  the  following  data: 


II  1U  111  2o  121 

I  Label  ISHOCXbbbbb  It,  et>  p,  e 

II  lo  111  20(21 

I Label  IRANGEbobbb | x ,  ex»  n,  e^ 

where 


t  *  shock  arrival  tine,  s, 
et  =  standard  error  of  t,  s, 
p  =  shock  overpressure.  Pa, 
ep  =  standard  error  of  p.  Pa, 

x  =  range  (ground  distance)  of  observation  station,  m, 
ex  =  standard  error  of  x,  m, 
h  *  elevation  of  observation  station,  m, 
e  =  standard  error  of  h,  m. 

The  "Label"  is  a  ten  character  alphanumeric  identification  of  the  observation. 

Missing  t-  or  p-  observations  are  indicated  by  a  zero  or  a  blank  field,  (t  =  U 

or  e  =  0  indicate  a  missing  time  observation;  p  =  d  or  e  =  o  indicate  a  mis- 

L  p 

sing  pressure  observation.) 


The  maximum  number  of  shock  observations  that  will  be  read  by  the  program 
is  5u.  If  tne  number  is  less  than  50.  then  the  enu  of  the  snock  data  should  be 


indicated  by  another  blank  card.  The  minimum  number  of  shock  points  for  the 
model  fitting  is  four  because  the  model  function  contains  four  free  para¬ 
meters. 


After  the  data  have  been  processed  and  the  shock  model  parameters 
determined,  the  program  will  try  to  read  the  next  shock  fitting  case,  starting 
with  the  general  input.  The  execution  will  come  to  a  programmed  stop  if  the 
input  is  not  a  TITLE  or  PLOTLABEL  card,  for  instance,  if  it  is  a  blank  card. 

The  computing  time  for  a  typical  shock  fitting  problem  is  less  than  20 
seconds  on  the  CDC  7600. 


5.3  Shock  Fitting  Process  and  Output 


The  shock  fitting  is  done  by  a  least  squares  process  with  constraint 

equations  derived  from  the  model  functions  p  and  t  ,  defined  by  Equations  5.1 

s  s 

and  5.2.  Let  p^,  r^  and  t^  be  the  observed  shock  overpressures,  distances 

from  the  center  of  explosion  and  shock  arrival  times,  c  . ,  c^  and  cfc^  be  the 

corresponding  residuals,  and  let  s  be  the  number  of  observed  shock  points. 

Then  the  constraints  are  formulated  as  follows: 


Fli  ’  <Pi  +  cpi)(ri  +  cri'3  -  (ri  +  cri|3  pS(ri  +  cri;  a'b'c)  =  0' 
F2i  =  Vs"!  +  cri'  a'b'c'd>  '  (ti  *  cti>  =o  *  0  '  1  '  1 . 


(5.3) 


s. 


The  distance  r ^  is  calculated  from  the  range  (ground  distance)  xi  and 

(5.4) 


elevation  Ik  by 


rA  =  (x.2  +  (h.  -  H) 2) 1/2 


with  the  estimated  standard  error 


n 


=  [ (x.e  . ) 2/r . 2 

1  XI  1 


((h.-H)/r.)‘ 


(ehi‘ 


+  eH  )  1 


1/2 


(5.5) 


The  arbitrary  constant  r  in  the  function  t  ,  Equation  5.2,  is  set  equal  to 

o  s 

the  smallest  observed  distance  r^. 

The  least  squares  objective  function  is 


s 

w  -  L 


+  (cti/eti) 


(5.6) 


i»l 

It  is  minimized  subject  to  the  constraints  5.3.  The  minimization  is  done  by  a 
version  of  the  least  squares  utility  routine  COLSMU  (Reference  4)  for  problems 
with  multi-component  constraints.  The  flexibility  of  the  routine  permits  one 
to  use  also  such  data  sets  from  which  either  the  overpressure  observation  p. 


or  the  time  observation  t^  is  missing.  (The  constraint  for  such  an  incomplete 
data  set  is  only  one  of  the  two  Equations  5.3.) 

The  data  fitting  is  done  in  four  steps: 

Step  1.  Only  pressure  is  adjusted.  This  renders  the  problem  linear 

in  the  parameters  (only  the  first  equation  of  Equation  5.3  is 
used)  and  provides  a  convenient  method  to  obtain  initial 
approximations  of  the  parameters  a,  b  and  c. 

Step  2.  Only  pressures  and  distances  are  adjusted.  This  provides  better 
initial  approximations  of  the  three  parameters  a,  b  and  c  for 
the  next  step. 

Step  3.  Simultaneous  adjustment  of  all  observations:  pressure,  distance 
—  and  time.  This  provides  the  final  values  of  all  four  para¬ 

meters,  a,  b,  c  and  d. 

Step  4.  Only  pressures  and  times  are  adjusted.  This  is  merely  a  test 

for  the  effect  of  distance  measurement  inaccuracies.  The  result 
of  this  step  corresponds  to  the  assumption  that  distances  are 
measured  without  errors.  We  notice,  however,  that  the  "distanc¬ 
es"  are  measured  from  an  imaginary  and  ill  defined  "center  of 
explosion."  Therefore,  very  small  distance  errors  are  probably 
not  a  realistic  assunption  and  the  range  standard  errors  ex,  to 

be  specified  by  input,  probably  should  be  larger  than  the 
range  survey  errors. 

The  output  of  the  shock  fitting  program  consists  of  printed  summaries  of 

the  general  data  and  shock  data  in  self-explaining  formats,  and  of  printed  and 

plotted  results  of  the  four  adjustment  steps.  The  printed  output  of  the 

adjustment  steps  also  includes  standard  output  generated  by  the  least  squares 

subroutine  COLSMU,  which  may  be  useful  in  case  of  algorithmic  difficulties. 

Normally,  the  only  relevant  output  is  the  self-explaining  summary  of  the 

adjustment  results  in  Step  3.  Corresponding  plots  of  p  (r),  p  (t)  and  r  (t) 

s  s  s 

curves  serve  as  illustrations  and  provide  a  visual  check  of  the  adjustment 
quality  in  all  four  steps.  Examples  of  output  plots  are  reproduced  in 
Reference  1. 

5.4.  Structure  of  the  Shock  Fitting  Program 

The  shock  fitting  program  consists  of  a  main  program  and  15  subroutines. 
Figure  2  shows  a  flowchart  of  the  main  program.  iTie  hierarchy  of  the  various 
subroutines  is  shown  in  Figure  3  and  the  communications  between  the 
subroutines  through  COMMON  blocks  is  displayed  in  Figure  4.  A  listing  of  the 
programs  is  given  in  Appendix  A.  The  contents  of  the  six  COMMON  blocks  that 
are  used  in  the  shock  fitting  programs  are  as  follows: 

COMMON/AMBCHA/p  ,  T,  7  ,M,  V,  E,  H,  eu. 

O  O  n 
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MAIN  PROGRAM  SHOKFIT 


Figure  4.  Access  to  COMMON  Blocks  by  Shock 
Fitting  Subroutines. 

A  circle  indicates  the  subroutine  which  enters 
data  into  the  COMMON  block. 
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This  block  is  filled  by  the  subroutine  READAM  and  its  contents  are 


pQ  =  ambient  pressure,  Pa, 

Tq  =  ambient  temperature,  K, 
y  =  ratio  of  specific  heats, 

M  =  molar  mass,  kg/mol, 

V  =  volume  of  fire  ball,  m^, 

E  =  re  leased  energy,  J, 

H  =  height  of  burst,  m, 
e„  =  standard  error  of  H,  m. 

H 

C0MM0N/CF2DER/  Y  ,  cq,  a,  b,  c,  d,  Xmin,  Sr,  Sp,  sfc. 

This  block  is  filled  by  the  subroutines  SCALSH  and  F2SHCK.  Its 
contents  are 


r 

c 


=  [  C+  y  )/(2V)  ]  (Ps/P0) ,  (factor  in  Equation  5.2), 
=  (rTQ  8.3143/M) 1//2  sfc/sr,  (sound  speed). 


a,  b,  c,  d  -  shock  parameters,  see  Equations  5.1  and  5.2, 

x  •  =  (x./s  )  .  , 

mm  i  r  mm 

s  =  distance  scale,  m, 

r 

Sp  =  pressure  scale.  Pa, 

sfc  =  time  scale,  s. 

COMMON/EMISFM/MISPDT(3,50) ,  DISTN(50),  NODIST,  SCD. 

This  block  is  filled  by  the  subroutines  SCALSH  and  FITSH.  its 
contents  are 


MISPDT(3,50)  =  a  non-zero  in  this  array  indicates  a  missing 

component  of  the  observation  vector  (p.,  r.,  t. 
i  =  1,  ...,  50.  ill 

DISTN  (50)  =  scaled  distances  r./s 

l  r 

NODIST  =  a  non-zero  indicates  for  the  subroutine  FMSHCK 

that  the  distances  are  not  to  be  adjusted,  but 
the  values  from  DISTN  used.  This  is  set  by  the 
subroutine  FITSCH. 

SCD  =  distance  scale  s  ,  m. 


COMMON/CMPLSH/  p  .  ,  p  ,  r  .  ,  r  ,t.,t 

rmin'  Mnax'  min'  max  mm'  max 

This  block  is  filled  by  the  subroutine  SCAI£H  and  its  contents  are 
the  extremes  of  the  observed  values  of  overpressure  p  (Pa),  distance  r 
(m)  and  time  t  (s) . 

CCMMON/COISHDT/TPXH (4,50),  ERTPXH (4, 50) ,  TITLE (3) ,  ALAB(2,50) 

This  block  contains  the  raw  shock  observations.  It  is  filled  by  the 
subroutine  READSH  and  its  contents  are 

TPXH(4,50)  =  observation  vectors  (t,p,x,h)  for  up  to  50 

observation  sets.  The  units  of  the  observations 
are  (s,  Pa,  m,  m) . 

ERTPXH(4,50)  =  estimated  standard  errors  of  the  observations  in 
TPXH. 

TITLE (3)  =  alphanumeric  title  of  the  computer  run,  read  from 

the  TITLE  card. 

ALAB(2,50)  =  alphanumeric  identifications  of  the  observation 

sets. 

CQMMON/PLOT/ro ( 6 ) , PLABL ( 4 ) 

This  block  is  filled  by  the  subroutine  READAM  and  it  contains 
information  for  the  plotting  routines. 


FD(6) 


=  contents  of  the  PLOTTING  DATA  card.  Only  the 
first  two  components  are  used:  ED(1)  =  f  , 

ED (2)  =  f.  See  Section  5.2.  p 


PLABL (4)  =  label  for  Calcomp  plots,  read  from  the  PLOTLABEL 

card. 


6.  BLAST  FIELD  OVERPRESSURE  FITTING  PROGRAM  BLAFOP 


6.1.  FMrpose  of  the  Program 

The  purpose  of  the  program  is  to  determine  from  measurements  of  overpres 
sure  histories  at  a  number  of  stations  a  model  function  that  approximately 
describes  the  overpressure  field  within  a  limited  region  behind  the  shock. 

The  model  function  has  the  form 


pf  =  [ps(r)  -c<r^e  TA(r)  +  T  B(r)  +  c(r). 


where  T  =  t  -  t  (r) , 


(6.2) 


pg(r)  and  tg(r)  are  known  functions  describing  the  incidental  shock  overpres¬ 
sure  and  arrival  time,  and  A(r),  B(r)  and  C(r)  are  unknown  functions  of  the 


distance  r  from  the  center  of  the  explosion,  to  be  determined  by  the  program. 
The  region  in  which  the  fitted  overpressure  field  function  p^  approximates  the 

overpressure  field  is  indicated  in  Figure  1.  The  three  adjustable  functions 
of  r  are  defined  by 


A(r)  =  (A1  +  A2r)/r  , 

n 

B (r )  =  (Bx  +  B2r)/r  B,  (6.3) 

nc 

C(r)=  cy r 

The  three  exponents,  n^,  ng  and  nc,  are  determined  by  a  trend  analysis  of  the 

overpressure  histories,  and  the  functions  pg(r)  and  tg(r)  are  determined  by 

shock  fitting  (see  Section  5).  Thus  the  function  given  by  Equation  6.1  con¬ 
tains  five  free  parameters,  A^,  A2,  B2  and  cy  which  are  determined  by  a 

least  squares  approximation  to  the  pressure  history  data.  A  program  listing 
is  given  in  Appendix  B  and  the  subroutines  of  the  program  are  described  in 
Section  8. 


6.2.  Input  for  the  Blast  Field  Overpressure  Fitting  Program 


The  input  consists  of  three  parts:  general  data,  results  of  the  shock 
fitting  described  in  Section  5,  and  overpressure  history  observations. 


The  general  data  are  provided  by  three  mandatory  and  three  optional 
cards.  The  format  and  the  contents  of  the  cards  are  the  same  as  for  the 
general  data  input  for  shock  fitting  described  in  Section  5.2.  (The  cards  are 
read  by  identical  subroutines.)  The  end  of  the  general  data  batch  is 
indicated  by  a  blank  card. 


The  shock  fitting  results  are  provided  by  four  cards  in  arbitrary  order. 
The  cards  contain  the  shock  fitting  parameters  and  their  error  estimates.  The 
format  of  all  four  cards  is  (2A10,6E10. 3)  and  their  contents  are  as  follows 


II  121 

ISHOCKPAR  |a,  b,  c,  d,  tQ 

|l  121 

loHOCKPARERRORS  |eQ,  eb,  ec,  ed 


SHOCKPARCORCOEF 


I21 

*cab'  cac'  cad'  cbc'  cbo'  ccd 


I1  I21 

| SHOCKSCALESbR , P , T  |sc,  Sp,  St  . 


The  end  of  the  shock  fitting  data  is  indicated  oy  a  blank  card. 
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The  numerical  contents  of  the  four  cards  is  normally  taken  from  the 
results  of  the  third  step  of  shock  fitting.  (See  Section  5.3.)  The  meaning 
of  the  contents  of  the  cards  is  as  follows 

a,  b,  c,  d  =  shock  fitting  parameters,  see  Equations  5.1  and  5.2. 

r  =  shock  distance  for  arrival  time  d. 

o 

e  ,  e^,  e  ,  =  standard  errors  of  the  shock  fitting  parameters.  The 

L  u  standard  error  of  weight  one,  eQ,  generally  should 

be  included  as  a  factor  in  these  estimates,  if  e  is 

o 

larger  than  one,  or  deviates  considerably  from  one. 

c  ^  through  c^  =  correlation  coefficients  of  the  shock  fitting 
parameters. 

scales,  in  metres,  pascals  and  seconds,  of  distance, 
pressure  and  time  which  are  used  to  express  the  shock 
parameters.  If  the  shock  parameters  are  expressed 
in  SI  base  units,  then  the  scales  are  1  m,  1  Pa  and 
1  s,  respectively. 

The  third  batch  of  input  consists  of  cards  containing  overpressure  his¬ 
tory  observations.  Each  overpressure  history  is  entered  by  one  card  contain¬ 
ing  the  range  and  elevation  of  the  pressure  transducer,  and  a  number  of  other 
cards  each  containing  an  observed  time  and  corresponding  overpressure  at  the 
station.  The  number  of  t,p-observation  sets  must  be  at  least  four  for  each 
station.  The  total  number  of  stations  must  be  at  least  two  and  not  more  than 
50,  and  the  total  number  of  t,p-observations  in  all  stations  is  limited  to 
5000.  All  cards  pertaining  to  one  history,  including  the  range  and  elevation 
card,  should  be  in  one  batch.  Their  order  within  the  batch  is  arbitrary  .  Th 
format  of  the  cards  is  (2A10,  6E10.3).  The  first  word  (A10)  is  a  label  iden¬ 
tifying  the  station,  that  is,  the  overpressure  history,  and  it  should  be  the 
same  in  all  cards  belonging  to  that  history.  A  different  label  indicates  for 
the  computer  the  beginning  of  a  new  batch  pertaining  to  a  different  history. 

The  contents  of  the  cards  are  as  follows: 


1 

11 

20 

21 

Label 

RANGE,  ELEV 

x,  e  , 

'  x' 

h. 

eh 

1 

11 

20 

21 

Label 

TIME,PRESb 

t,  efc. 

P  r 

8P 

where  x  =  range  (ground  distance)  of  the  station,  m 

e  =  standard  error  of  x,  m, 
x 

h  =  elevation  of  the  station,  m. 


e,  =  standard  error  of  h,  m 


t  =  time  after  detonation,  s 


e  =  standard  error  of  t, 
s 

p  =  overpressure  at  time 
=  standard  error  of  p. 
The  enu  of  all  data  is  indicated 


s, 

t.  Pa, 

Pa. 

by  a  blank  card. 


Tne  computing  time  for  a  typical  case  (5  histories,  and  a  total  of  lbo 
t ,p-ooservations)  is  less  than  1U6  seconds  on  the  CDC  ?6uu. 


t> . 3  Overpressure  Field  Fitting  Process  and  Output 

The  overpressure  fielo  function  is  determined  in  two  steps.  First,  a 
three  parameter  exponential  function 


pn  =  (Ps  +  C)eAT+  dT  -  C,  (6.4) 

with  t  =  t-ts,  is  fitted  to  each  overpressure  history.  Then  tne  depenaence 

of  tne  fitting  parameters  A,  E  and  C  of  the  individual  histories  on  the 
distance  r  from  tne  explosion  is  analyzed,  and  power  function  approximations 
are  determined  in  the  form 

A(r)  »  A0/r  ,  B(r)  =  BQ/r  u,  C(r)  =  CQ/r  .  (6.5) 

Tne  ensuing  values  of  the  exponents  n^,  n0  ana  nc  are  used  in  Equation  6.3  to 
construct  the  overpressure  field  function. 


The  second  step  consists  of  a  joint  fitting  of  all  ooservations  to  the 
overpressure  model  6.1  through  6.3.  Free  parameters  for  that  fitting  are  the 
five  constants  A^,  A^,  arK^  C^. 

The  output  starts  with  a  comprehensive  summary  of  all  input  data.  Next, 
the  individual  histories  are  fitte-o  using  a  version  of  the  least  squares 
utility  routine  CC'LSAC  (Reference  4)  with  the  constraint  function 

fci  =  ?n(ti  +  ct i'  A'  B'  C)  "  (pi  +  cpi)  '  1  =  (b,b) 

where  t.  ano  p.  are  tne  oDserved  times  ana  pressures,  c. .  and  c  .  at.  the 

11  ‘  tl  ^-*1 

corresponding  residuals,  and  the  function  is  defined  by  Equation  6.4.  (Tne 

function  p,  is  different  for  each  history  because  the  shock  values  po  and  t 

are  different  for  each  history.)  COLSAC  prints  the  adjustment  results  in  a 
stsnaaro  form,  which  is  supplemented  oy  a  self-explaining  list  of  adjust 
acta  ana  parameter  values.  In  aauition,  Calcomp  plots  arc  generated  of  each 
adjusted  history,  providing  a  visual  check  of  aata  and  adjustments.  At  tne 
end  of  the  first  step  a  list  of  the  parameters  A,  B  and  C  of  all  histories  is 
proviac'd  togetnor  witn  tne  exponents  n  ,  n  anu  n^,  ana  the  values  of  Aq,  Bq, 
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'  ■  j  v.  y,  J". 


1" .  „■ 1  v 


a 


a 


y 


r.  - 


ana  CQ.  Tne  three  parameters  A,  B  and  C  are  also  snown  in  log , log-plots  as 
functions  of  r. 

In  tne  second  step,  tne  joint  fitting  of  all  observations  is  done  in 
substeps  to  avoid  algorithmic  difficulties.  First,  only  overpressure 
observations  are  aujustea;  then  overpressure  and  time  observations  are 
aa justed,  and  finally,  overpressure,  time  and  oistance  observations  are 
aa justed.  Tne  adjustments  are  again  done  by  the  COLSAC  routine,  now  using 
constraints  derived  from  the  model  function  6.1  through  6.3.  The  constraints 
are  formulated  as  the  function 


£i  -  Pf‘ri  +  cri'  +  ctiJ  V  V  V  V  Cl>  '  <Pi  *  V  *  U’1  - 

lb.  /) 


wnere  is  defined  by  Equation  6.1.  The  output  consists  of  the  standard 

output  by  COLSAC,  and  after  the  third  substep,  a  list  of  the  adjusted  obser¬ 
vations  and  a  list  of  the  overpressure  field  parameters  in  SI  base  units.  For 
each  history  a  plot  is  provided  of  the  overpressure  field  function,  its 
confidence  limits  and  the  corresponding  observations.  A  final  plot  gives  in 
the  r,t-plane  the  locations  of  the  observed  histories,  the  shock  trajectory 
and  some  particle  path  lines.  The  latter  plot  can  be  used  for  the  planning  of 
experiments,  because  it  provides  an  indication  of  the  domain  in  which  the  flow 
field  can  be  reconstructed  and  checked  by  test  calculations.  (See  Figure  1.) 
Examples  of  tne  various  plots  are  given  in  Reference  1. 

6.4.  Structure  of  the  Overpressure  Field  Fitting  Program 

The  overpressure  field  fitting  program  consists  of  a  main  program  and  41 
subroutines.  Five  of  the  subroutines  (C0L3ACA,  C0LSAC3,  MTRINDB,  LUDATD, 
LUELMD)  belong  to  the  least  squares  model  fitting  utility  routine  COLSAC 
(Reference  4) ,  and  usually  are  not  included  in  a  special  application  program, 
but  attached  as  needed  for  a  particular  computer  run.  For  the  present 
application  tne  set  of  routines  was  modified,  and  the  program  package  contains 
the  modified  version.  The  modifications  concern  the  use  of  the  LEVEL2  option 
for  certain  arguments  of  these  subroutines.  LEVEL2  variables  were  necessary 
in  order  to  accomodate  the  possibly  large  number  of  data  within  the  present 
computer  configuration  at  BRL.  (The  shock  fitting  program  described  in  Section 
5  uses  a  standard  version  of  the  least  squares  routine  COLSMU,  which  is 
therefore  not  included  in  the  program  package,  but  attached  at  run  time.) 

A  flowchart  of  the  main  program  is  shown  in  Figure  5.  Most  of  the 
subroutines  that  are  called  from  the  main  program  are  quite  simple.  Tne 
structures  of  the  two  more  complicated  subroutines,  FITPR  and  FTPFLD,  are 
illustrated  by  Figures  6  and  7.  At  a  lower  level,  the  subroutine  PFIELD  for 
the  computation  of  the  overpressure  field  is  more  involved  and  its  hierarchy 
is  shown  in  Figure  8. 

A  list  of  COMMON  blocks  is  given  in  Figure  y  together  with  the  names  of 
subroutines  which  have  access  to  the  blocks.  Seven  of  the  16  blocks  are  dummy 
blocks,  and  needed  only  because  of  idiosyncrasies  of  the  LEVEL2  option.  (They 
are  not  used  to  transmit  information  between  different  parts  of  the  program.) 
Several  other  blocks  are  identical  to  those  used  in  the  snock  fitting  Drogram, 
Section  5.  A  description  of  the  contents  of  the  COMMON  blocks  follows. 
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START 


READ  AMBIENT  DATA 


READ  SHOCK  FITTING  PARAMETERS 


READ  OVERPRESSURE  HISTORY  DATA 


PREPARE  ONE  HISTORY  FOR  FITTING 
FIT  ONE  HISTORY 
PRINT  RESULTS  IN  SI  UNITS 
PLOT  FITTING  RESULTS 


REPEAT  FOR  ALL  HISTORIES 


PRINT  SUMMARY.  COMPUTE  EXPONENTS 
PLOT  PARAMETERS  v*  DISTANCE 


FIT  ALL  OVERPRESSURE  DATA 


PRINT  RESULTS  IN  SI  UNITS 

PLOT  HISTORY  LOCATIONS  IN  r,t -PLANE 


Figure  5.  Main  Program  OPRF.FIT  for  Overpressure  Field 
Fitting. 
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I'he  subroutine  handles  the  total  overpressure  field  fitting.  Arrows  indicate  calling  direction. 


PFIELD 


COMMON  Block 
NAME  and  Length 

AMBCHA,  8 

CFLDEX,  3 

CF2DER,  10 

COM PR,  30150 
CCMSHK,  24 
CPARG,  155 
CSCALE,  3 
GUECM,  60 
PLOT,  10 
PSTS,  2 
SCRCH,  13660 
SCRCHA,  195 
SCRCH 2,  114307 
SCRCH 3,  155 
SCRCH4,  140 


Subroutines  with  access  to  the  CCWON  Block 

READAM,  READS P,  READPR,  PLTLOC,  SHOCK,  STRBEG 

ACOEF,  BCOEF,  CCOEF,  FTPFLD 

F2DER,  FRSHCK,  READSP,  SHOCK,  SHOCK2,  SHTINT,  SHODER. 
STRBEG 

FTPFLD,  READPR,  SCALPR,  PLTFLD 

READSP,  QFUNCT,  SHOCK,  SHOCK2,  SHODER,  STRBEG 

PLTFLD 

FTPFLD, QFUNCT,  PLTLOC,  STRBEG,  PLTFLD 
GUESS,  FLDGES 

READAM,  PLTPAR,  PLTPNTS,  PLTLOC,  PLTFLD 

FITPR,  EXPON,  PLTPNTS 

FITPR 

PLTPNTS 

FPTFLD,  PLTFLD 

STRLIN 

PLDAUX 


TPINDX,  2 


FTPFLD,  FLDGES,  FIELD,  QFUNCT,  PRTFLD,  STRLIN,  PLTFLD 


CCMMON/AMBCHA/  -  see  the  description  in  Section  5.4. 

CCMMON/CFIDEX/nA,  nB,  nc> 

This  block  contains  the  three  exponents  in  the  field  function. 
Equations  6.1  through  6.3.  The  block  is  filled  by  the 
subroutine  FTPFLD. 

CCMM0N/CF23ER/  -  See  the  description  in  Section  5.4. 

COIMON/CCM PR/TP  (2,5000),  ERIP  (2,5000),  ALB  (2,  5000),  NSET(50),  DIST(50), 
EROIST(50) . 

This  block  contains  the  raw  input  from  history  observations. 

It  is  filled  by  the  subroutine  READ PR.  Its  contents  are 

TP(2, 5000)  -  time  and  pressure  observations, 

ERTP(2, 5000)  -  corresponding  standard  errors, 

ALB (2, 5000)  -  labels  of  the  observations, 

NSET(50)  -  numbers  of  t,p-observations  in  each  history;  up 
to  50  histories  are  permitted, 

DIST(50)  -  ranges  (ground  distances)  of  up  to  50  pressure 
transducer  locations, 

ERDI ST (50)  -  standard  errors  of  the  ranges  in  DIST. 

CCMMON/COMSHK/NPS,PAR(4),VPAR(4,4),  S  ,  S  ,  S  . 

r  p  u 

This  block  contains  the  shock  fitting  parameters  and  their 
variances.  The  block  is  filled  by  the  subroutine  READSP  and 
its  contents  are 

NPS  -  number  of  shock  parameters ;  this  is  a  set  equal  to 

four, 

PAR(4)  -  shock  parameters  a,b,c,d, 

VPAR(4, 4)  -  variance-covariance  matrix  of  the  shock 

parameters, 

s  ,  s  ,  s  -  length,  pressure  and  time  scales  which  are  used 
r  P  to  express  the  shock  parameters. 

CCMMON/C  PARG/ 

This  is  a  dummy  block,  necessary  to  use  the  LEVEL2  memory  option. 


COMMON /CSC ALE/ s  ^ ,  s  ,  st 

^his  block  contains  tne  scales  for  distance,  pressure  anu  time 
.iich  are  usea  for  the  calculations  in  this  program.  They  are 
set  by  FTPFLD  in  accordance  with  the  general  input. 

CQMMON/GUECM/ 

This  is  a  dummy  block,  necesary  to  use  the  LEVEL2  memory  option. 
COMMQN/PLOT/ 

See  description  in  Section  5.4. 

COMMON /PSTS/ps , t  s 

This  block  contains  a  snock  overpressure  and  a  corresponding 
shock  arrival  time.  It  is  set  by  the  subroutine  FITPR. 

COMMON /SCKCH/ 

CCGiMON/ SCRCHA/ 

CGMMQN/SCRCH2/  »  Dummy  blocks  necessary  to  use  the  LEVEL2 

memory  option. 

COMMON/SCRCH3/ 

COMMON/ SCRCH  4 / 

COMMON/TP INDX/i .  ,  i 
^  P 

This  block  contains  two  indices  signifying  the  time  and  pressure 

components  of  the  three  component  observation  (p,t,r). 

Subroutine  FTPFLD  sets  i  =  2,  i  =1. 

t  p 


7.  BLAST  FIELD  HISTORY  COMPUTATION  PROGRAM  BLftFHI 
7.1.  Purpose  of  the  Program 

The  purpose  of  the  program  is  to  compute  blast  field  histories  at  given 
locations  using  a  previously  determined  overpressure  field  function.  The 
computation  process  is  schematically  described  in  Section  2  and  illustrates  uy 
Figure  1.  It  consists  in  essence  of  numerical  integrations  of  a  number  ol 
selected  path  line  equations  and  of  quadratures  over  flow  field  functions 
along  lines  t  =  const.  The  results  of  these  calculations  produce,  at 
specified  distances  r,  histories  of  overpressure  p,  particle  velocity  u, 

density  p,  dynamic  pressure  pu^/2  and  temperature  T,  all  with  estimated 
stanaard  errors.  A  program  listing  is  given  in  Appendix  C  and  the  suoroutines 
of  tne  program  are  described  in  Section  b. 
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7.2.  Input  for  the  Blast  Field  history  ComDutation  Pr 


ogram 

The  input  consists  of  four  parts:  general  data,  results  of  the  shock  fit¬ 
ting  described  in  Section  5,  results  of  the  overpressure  field  fitting  de¬ 
scribed  in  Section  b,  and  instructions  as  to  what  calculations  are  to  be  done. 
Tne  tour  data  groups  are  entered  as  four  batcnes  of  input  cards,  separated  by 
a  blank  card  at  the  end  of  each  batch. 

The  general  data  are  provided  by  three  mandatory  and  three  optional 
cards.  The  format  and  the  contents  of  the  cards  are  the  same  as  for  the 
general  data  input  for  shock  fitting  described  in  Section  5.2. 

The  shock  fitting  results  are  provided  by  the  four  cards  described  in 
Section  6.2. 

The  overpressure  field  fitting  results  are  entered  by  seven  cards 
containing  the  overpressure  field  parameters  and  their  estimated  standard 
errors.  The  format  of  the  cards  is  (2A1U,  6E1U.3)  and  their  order  is 
arbitrary.  The  contents  of  tne  caras  are  as  follows: 

II  121 

IFIELDPAH  |ai,  A2,  B1#  B2,  Cj 

These  are  the  five  overpressure  field  parameters,  see  Equations 
6.1  through  6.3. 


I1  I21 

IfIELDPARERRORS  le^,  e^2,  e^,  e32,  ecl 

These  are  the  standard  errors  of  the  overpressure  field 
parameters. 


11 

121 

iFIELDPARCObl 

C12' 

C13'  C14'  C15'  °23 

11 

121 

|FIELDPARC0b2 

C24 ' 

C25'  C34 '  C35'  C45 

These  cards  contain  the  correlation  coefficients  between  the 
overpressure  field  parameters. 

II  121 

IFIELDPAREXPONENTS  |n.,  nQ,  n_ 

A  D  L 

These  are  the  exponents  in  the  overpressure  field  function,  see 
Equation  6.3. 

II  1 21 

IFIELDPAPSCALES  |sr ,  s  , 

Scales  in  metres,  pascals  and  seconds,  of  distance,  pressure 
and  time  that  are  used  to  express  the  overpressure  field 
parameters. 


FIELDPARRANGE  Jr  .  ,  r 

nun  max 

Distances  in  metres  between  which  the  overpressure  field 
function  is  assumed  to  approximate  the  real  overpressure. 

The  end  of  the  pressure  field  data  is  indicated  by  a  blank  card. 

The  computing  instructions  are  entered  by  one  card  for  each  set  of 
histories  that  are  to  be  calculated.  The  card  has  the  format  (2A10,6E10.3) 
and  the  following  contents: 

I1  I21 

iHISTORYbR,TMAX,NRPTS  r,  t  ,  n 

max 

where 

r  =  distance  from  the  center  of  explosion  at 
which  the  histories  should  be  computed,  m, 

t  =  end  t™e  for  historY  calculations,  s, 

n  =  approximate  number  of  nodes  to  be  calculated;  n  should 
not  exceed  100. 

The  program  starts  the  calculations  after  a  HISTORY  card  is  read.  After 
completing  calculations  the  program  tries  to  read  the  next  HISTORY  card.  A 
blank  card  indicates  the  end  of  the  input  and  will  cause  the  program  to  stop. 

A  typical  computing  time  for  a  history  with  80  nodes  is  150  s  on  the  CDC 

7600. 

7.3  Blast  Field  History  Computation  Process  and  Output 

A  short  description  of  the  computation  process  is  given  in  Section  2  and 
the  process  illustrated  by  Figure  1.  More  detailed  information  about  the 
numerical  integration  of  the  path  line  and  derivative  equations  is  given  in 
Reference  1,  Section  3.  The  actual  history  is  obtained  at  the  prescribed 
distance  r  and  for  equidistant  time  values  by  interpolation  in  the  r,t-plane 
between  path  lines.  Details  of  the  interpolation  process  are  given  in  the 
description  of  the  subroutine  FL INTER. 

The  output  of  the  program  consists  of  a  comprehensive  summary  of  all  in¬ 
put  data,  that  is,  the  general  (ambient)  conditions,  the  shock  fitting  results 
and  the  overpressure  field  fitting  results,  followed  by  a  printed  list  of  the 
computed  histories.  The  list  contains  values  of  time  t,  overpressure  p,  veloc 

2 

ity  u,  density  P,  and  dynamic  pressure  P u  /2,  all  with  estimated  standard 
errors,  at  equidistant  time  intervals.  In  addition  to  these  histories  a  list 
of  the  test  velocities  is  printed  together  with  the  corresponding  original 
velocities  and  the  dynamic  pressures  computed  using  the  test  velocities. 


The  printed  output  is  supplonented  with  plots  of  the  five  histories  of  p, 
2 

u,p,pu  /2  and  T,  and  a  plot  of  the  dynamic  pressure  history  computed  using  the 
test  velocities  instead  of  the  original  velocities.  Examples  of  the  plots  are 
given  in  Reference  1. 

7.4.  Structure  of  the  Blast  Field  History  Computation  Program 

The  program  consists  of  a  main  program  and  28  subroutines.  Most  of  the 
subroutines  are  identical  to  those  used  in  the  shock  fitting  and  the  pressure 
field  fitting  programs.  A  flowchart  of  the  main  program  is  shown  in  Figure 
10,  and  a  flowchart  of  the  principal  subroutine  FLOWFLD  is  shown  in  Figure  11. 
The  routine  computes  the  flow  history  at  r  =  rD  by  calculating  a  number  of 

O 

particle  path  lines  (each  line  is  generated  by  calling  STRBEG  and  STRLIN)  and 
by  interpolation  between  the  lines  to  obtain  history  values  at  r  =  rB  and  for 

equidistant  t-values.  After  calculations  are  completed  the  output  routines 
PRIHIS,  UTEST  and  PRITST  are  called  to  print  results  and  to  compute  test 
velocities.  Other  subroutines  of  the  program  have  quite  simple  structures. 

The  somewhat  more  involved  structure  of  PFIELD  is  shown  in  Figure  8.  Short 
descriptions  of  all  subroutines  are  given  in  Section  8. 

A  list  of  COMMON  blocks  is  given  in  Figure  12,  showing  also  the  names  of 
those  subroutines  which  have  access  to  the  various  blocks.  Most  of  the  COMMON 
blocks  have  the  same  contents  as  corresponding  blocks  in  the  other  two  program 
parts,  BLAFS  and  BLAFOP.  Next,  we  give  a  description  of  the  COMMON  blocks. 

COMMON/AMBCHA/ 

This  block  contains  general  data  and  is  described  in 
Section  5.4. 

COMMON/CFLDEX/nA ,  nfi,  nc 

This  block  contains  three  exponents  of  the  overpressure  field 
function,  and  it  is  filled  up  by  the  subroutine  READFP.  (See  also 
Section  6.4.) 

C0MM0N/CF2DER/  -  See  the  description  in  Section  5.4. 

COMMON/COMFLD/P(5),V(5,5),sr,  sp,  st,  r^,  r^ 

This  block  is  filled  by  READFP  and  it  contains  the  parameters  of  the 
overpressure  field  function.  The  contents  of  the  block  are 

P (5)  =  (A^  A2,  B^ ,  B2,  C1)  =  overpressure  field 

parameter  vector; 

V(5,5)  =  variance-covariance  matrix  of  the  parameter 

vector  P; 


s  ,s  , 
r'  p 


=  scales  in  metres,  pascals  and  seconds  of 
distance,  pressure  and  time  in  which  the 
parameters  p  are  expressed; 


READ  GENERAL  DATA 

READ  SHOCK  FITTING  RESULTS 

READ  OVERPRESSURE  FIELD 
FITTING  RESULTS 

1 — ^CsiDP  if  cord  is  blank) 

COMPUTE  HISTORIES  AS  SPECIFIED 
BY  THE  HISTORY  CARD 

PLOT  COMPUTED  HISTORIES 


Figure  10.  Main  Program  HISTORY  for  Flow  History  Computation. 
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'i^urc  11.  Howcluirt  of  Subroutine  I'LOI'LI). 
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=  distance  range  in  metres  for  which  the  overpres 
sure  field  function  is  assumed  to  hold. 


COMMON/COMSHK/  -  See  the  description  in  Section  6.4. 


COMMON/COUTST/t,P (10) ,  Y  »PQ 

This  block  contains  information  about  the  test  computation  by  the 
quadrature  Equation  2.12.  It  is  filled  by  the  subroutine  OTEST 
and  its  contents  are 


t  =  time  for  which  the  integration  is  done,  expressed  in 
the  sfc  units  that  are  used  for  calculations 

P(10)  =  the  nine  overpressure  field  parameters  A^,  B^,  B 2, 

C^,  a,  b,  c,  d.  The  tenth  component  of  P  is  not  used. 

y  =  ratio  of  specific  heats. 


=  ambient  pressure  expressed  in 
are  used  for  calculations. 


the  s  units  that 
P 


COMMON/CSCALE/  -  see  the  description  in  Section  6.4. 


COMMON/PLOT/  -  see  the  description  in  Section  5.4. 


8.  DESCRIPTIONS  OF  SUBROUTINES 

This  section  contains  short  descriptions  of  all  subroutines  in  alpha¬ 
betical  order.  The  listings  of  the  subroutines  in  Appendices  A,  B  and  C 
contain  additional  comments.  Some  subroutines  are  used  in  more  than  one  of 
the  BLAF  programs,  and  listed  in  more  than  one  Appendix,  as  indicated  in  the 
headings  of  the  following  descriptions. 

ACOEF  (Appendices  B  and  C) 

This  subroutine  computes  the  function  6.3, 

nA 

A(r)  =  (A1  +  A2r)/r 

and  its  first  and  second  order  derivatives  with  respect  to  t,p,r  and  the  five 
parameters  PAR  =  (A^A^B^B^C^) .  It  is  called  from  QFUNCT  and  it  uses 

COEFFI  for  the  actual  calculations.  The  conventions  for  the  arguments  are 


t  =  X 


This  routine  computes  the  function  6.3 


rv. 

B(r)  =  (B1  +  B2r)/r  “ 

and  its  first  and  second  order  derivatives.  Its  structure  and  conventions  are 
the  same  as  those  of  ACOEF. 

CCOEF  (Appendices  B  and  C) 

This  subroutine  computes  the  function  6.3, 


C(r)  =  Cj/r  , 

and  its  first  and  second  derivatives.  (See  also  ACOEF.) 

COEFFI  (Appendices  B  and  C) 

This  is  an  auxiliary  routine  for  ACOEF,  BCOEF  and  CCOEF  and  it  calculates 
the  function 

py 

A  =  (P1  +  p2r)/r 

with  its  first  and  second  derivatives  with  respect  to  r,  p^  and  p2» 

COLSACA,  COLSACB  (Appendix  B) 

This  is  a  version  of  the  COLSAC  routine  (Reference  4),  modified  to 
conform  with  the  UEVEL2  memory  option  for  certain  of  its  arguments.  The  COLSAC 
routines  are  general  least  squares  adjustment  routines  for  scalar  constraints, 
generally  non-linear  in  terms  of  the  observations  and  parameters. 

DIMFLD  (Appendix  B) 

This  routine  computes  the  overpressure  field  parameter  values  in  base  SI 
units,  and  prints  a  comprehensive  summary  of  the  parameters  and  their  estima¬ 
ted  errors.  The  routine  is  called  from  the  main  program  for  overpressure 
field  fitting  after  completed  calculations,  and  DIMFLD  produces  the  last  page 
of  printed  output  for  that  program.  Information  from  this  page  is  used  as 
input  for  the  history  calculation  program. 

DIMPAR  (Appendix  B) 

This  routine  computes  and  prints  the  individual  overpressure  history 
paramaters  A,  B  and  C  of  Equation  6.4  in  base  SI  units.  It  is  called  from  the 
main  program  for  overpressure  field  fitting  after  the  individual  fitting  of 
each  overpressure  history. 

DIMPARS  (Appendix  A) 

This  routine  is  called  from  the  main  program  for  shock  fitting  after  each 
of  the  four  fitting  steps.  It  calculates  the  shock  fitting  parameters  in  base 


SI  units  and  prints  a  comprehensive  list  of  the  shock  parameters  and  their 
estimated  variances. 


EREhCM  (Appendix  B) 

This  routine  computes  201  nodes  of  an  error  ellipse  for  a  given 
variance-covar ianoe  matrix.  It  is  used  by  several  plotting  routines. 

EXPON  (Appendix  B) 

This  is  the  constraint  routine  for  the  three  parameter  exponential 
function.  Equation  6.4.  It  computes 


f  =  (Pshock  +  C)eAT  +  BT  -  c  -  P 


where  r  =  t  -  t  ,  . 

shock 

and  the  first  and  second  derivatives  of  f.  EXPON  is  used  as  constraint  by 
FITPR  when  the  latter  routine  calls  the  least  squares  routine  COLSACA  to  fit 
an  individual  overpressure  history. 


FITPR  (Appendix  B) 


This  routine  is  called  by  the  main  routine  for  overpressure  field  fitting 
to  carry  out  a  fitting  of  an  overpressure  history.  Figure  6  shows  the  hier¬ 
archy  of  FITPR. 


FITSH  (Appendix  A) 


This  routine  is  called  from  the  main  program  for  shock  fitting.  It  pre¬ 
pares  the  shock  data  for  least  squares  fitting  and  calls  the  fitting  routine 
COLSMUA.  A  modifier  KA  in  the  argument  of  FITSH  indicates  which  observations 
(pressure,  distance,  time)  should  be  adjusted  and  the  data  preparation  is  done 
accordingly.  The  constraint  routine  for  the  fitting  is  FMSHCK. 


FUDGES  (Appendix  B) 


This  routine  is  called  from  FTPFLD  to  provide  initial  estimates  for  the 
overpressure  field  parameters.  Of  the  five  parameters  in  Equation  6.3,  the 
initial  estimates  of  A^  and  B2  are  zero.  The  estimates  A,  B  and  C  of  A^, 

and  are  computed  by  the  following  algorithm. 

The  constraint  corresponding  to  Equations  6.1  through  6.3  can  be 
expressed  for  A2  =  B2  =  0  by 
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Let  C  De  an  approximation  to  C.  Then  the  above  equation  can  be  linearized  in 
terms  of  a  correction  epsilon  f  of  C  witn  the  result 


_  n  r* 

P  -C/r  - 


<ps  -  p)/r 

-  nC  -  nc 

(p-C/r  )  (ps-C/r  C) 


t-t  {t-t  r 

-  A  - -  -  B  - - —  -  0 

nA  nB 

r  r 


txe  use  this  equation  as  a  constraint  equation  with  the  first  term  as 
"observation."  We  define  for  each  observed  point 


pi  • 

-  "cl 

C/r. 

_  n 

p  • 

-C/r. 

SI 

x 

(psi  -  pi)/ri _ 

—  nQ  _  npN 

(pi  -  C/ri  }  (Psi  -  C/ri 


a.  =  (t.  -  t  ,)/r. 

i  i  si  i 


B.  =  (t.  -  t  ,)2/r.  B 

1  X  SX  1 


and  W.  =  (p.  -  C/r.  C)2/e2  . , 

x  i  l  pi 

where  e  .  is  the  estimated  standard  error  of  the  observation  p..  As  the  least 

pi  l 

squares  objective  function  we  chose 
s 

-  E  (yi  ■  aiA  -  eiB  ■  v)  wi  • 
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Tne  normal  eauc-tions  tor  this  problem  arc 


A  S  w.a.2  +  'w.a.  6 .  +  eN  Sw . a. y .  =  ^  w.a.y. 

AV w .  a .  6 .  +  '  w .  6  •  2  +  'w .  6 .  y  .  =  ^  '  w .  g .  y . 

Z^  ill  Z_^  i  i  Z-w  ill  Z_v  iii 

AZwiai +  BZ  7i6i  Yi +  eEvi2  =  Z  wiVi . 


Inc  subroutine  FLOGES  solves  tnese  normal  equations  one  iterates  four  times, 
replacing  C  by  C  +  e  after  eacn  iteration.  The  initial  approximation  C  is 
furmsheo  by  the  calling  proqram.  In  order  to  avoid  unreasonable  C  +  e  cue  to 
a  Duu  initial  guess  tne  following  restrictions  are  applied  to  the  corrected 
values  at  each  iteration: 


nC  -  nC 

-U.o(o.r.  )  <  C  +  c  < (o  r .  )  .  -  O.udl 

-  l  l  max  -  ii  min 


FLImTLR  (Appendix  C) 


p.  r . 

*1  l 


max 


This  is  an  interpolation  routine.  It  is  callea  by  the  subroutine  FL3FLD 
to  interpolate  between  two  given  particle  paths  ana  calculate  at  a  specified 

point  in  tne  r,t-plane  tne  vector  of  flow  variables  (p,u,  p,  u2  p/2)  ana  the 
corresponding  variance-covariance  matrix.  The  interpolation  is  done  in  two 
steps.  First,  alonq  each  particle  path  the  ooint  with  the  prescribed  time'  is 
determined  by  linear  interpolation.  Then  a  linear  interpolation  is  done  De¬ 
tween  these  two  nodes  in  the  r-direction.  Error  returns  are  programed  for 
cases  wnicn  would  require  extrapolation. 


FLUFLD  (Appencix  C) 


inis  subroutine  is  called  from  tne  main  proqram  tor  blast  field  nistory 
calculations  and  it  is  the  most  important  subroutine  of  that  program.  A 
flowcnart  of  FLOFLC  is  shown  in  Figure  11.  The  program  computes  tne  history 
at  a  given  location  (given  distance  r)  and  calls  other  subroutines  to  print 
the  results  and  to  compute  the  test  velocity  according  to  Figure  1.  In  order 
to  calculate  tne  nistory,  FLoFLD  computes  a  series  of  particle  path  lines  (dv 
calling  STK3EG  ana  PTRLiN) .  When  two  lines  are  computoc:  and  storeo,  FLOFLD 
calls  FLITTER  to  calculate  tne  flow  variaoies  at  specif  ic-j  r , t-noaes  by  inter¬ 
polation  between  tne  two  patn  lines.  If  tms  requires  an  extrapolation, 
FLITTER  returns  witr.  a  corresponding  error  indicator.  FLOFLD  tnen  calculates 
a  now  particle  path,  starting  at  a  proper  initial  point,  discards  one  of  tne 
previous  path  lines  and  calls  FLINTER  again.  After  all  required  nooes  of  the 
nistory  nave  Deen  computed,  tne  program  calls  PkldlS  to  print  the  results, 
UTLST  to  compute  test  velocities  ana  FKIfST  to  print  the  test  velocities. 

F.-1SHCK  (Appendix  A) 

This  is  tne  constraint  routine.  Equation  5. a,  for  tne  shock  fitting.  The 
particular  form  of  the  constraint  function  and  its  derivatives  are  given  in 


Reference  1,  pages  21-23.  The  program  is  called  from  the  least  squares 
subroutine  COLSMU.  It  contains  some  logic  to  handle  observations  with  missing 
time  or  pressure  values.  Information  about  missing  data  is  passed  to  ET4SHCK 
through  the  COMMON/CMISFM/.  The  routine  uses  SHOCK 3  and  F2SHCK  to  compute  the 
two  components  of  the  constraint  function. 

FTPELD  (Appendix  B) 


This  subroutine  is  called  from  the  main  program  for  overpressure  field 
fitting.  It  takes  the  raw  input  data  from  COMMON/COMPR/,  stores  the  data  in 
arrays  according  to  the  requirements  of  the  COLSAC  routine,  calls  FLDGES  to 
obtain  initial  approximations  for  the  overpressure  field  parameters,  and  calls 
the  least  squares  routine  COLSAC  to  compute  their  final  values.  The  adjust¬ 
ment  results  are  printed  by  calling  the  subroutine  PRTFLD  and  plotted  by  call¬ 
ing  the  subroutine  PLTFLD.  Normally  there  are  three  successive  calls  to 
COLSAC:  for  adjusting  pressure;  pressure  and  time;  and  pressure,  time  and 
distance,  respectively.  Other  calls  are  programmed  to  handle  cases  with  algo¬ 
rithmic  troubles  in  COLSAC.  Such  problems  can  arise  if  the  initial  approxima¬ 
tions  of  the  parameters  are  bad  and/or  large  residuals  are  present. 

F2DER  (Appendices  A,B,  and  C) 

The  calculation  of  the  shock  arrival  time  by  Equation  4.2,  and  its 
derivatives  requires  the  numerical  evaluation  of  nine  integrals  (see  Reference 
1,  pages  22-23).  These  integrals  are  calculated  simultaneously  by  a  special 
Romberg  routine  (ROMULT) .  The  subroutine  F2DER  computes  the  nine  components 
of  the  integrand,  and  it  is  called  from  ROMULT,  which  is  activated  by  F2SHCK. 

F2SHCK  (Appendices  A,B,  and  C) 

This  subroutine  represents  the  second  component  of  the  constraint  for 
shock  fitting.  Equation  5.2.  The  constraint  is  formulated  in  the  form 

f_  =  (t  -d)  c  +  (d-t.-c. .)  c  =0, 

2  'so  l  ti  o 

where  t.  +  c. .  is  the  corrected  time  observation  and  t  -d  is  the  integral  in 
l  ti  s  ^ 

Equation  (5.2).  The  formal  derivatives  of  this  function  are  listed  in  Refer¬ 
ence  1,  pages  22-23.  The  subroutine  computes  the  function  f2  and  its  first 

and  second  order  derivatives.  In  programs  other  than  the  shock  fitting 
program,  F2SHCK  is  used  to  compute  the  shock  arrival  time  for  a  given 
distance,  and  the  corresponding  derivatives. 

GRAPH  (Appendix  C) 

This  is  an  auxiliary  routine  for  the  plotting  routine  PLFFLD.  It  estab¬ 
lishes  scales  and  plots  those  parts  of  the  legend  that  are  common  to  all 
plots. 

GUESS  (Appendix  B) 


This  routine  provides  initial  estimates  of  the  overpressure  history 
function  parameters  for  individual  history  fitting.  It  is  called  from  the 


subroutine  FITPk  (see  Figure  6).  The  initial  estimates  are  obtained  by 
solving  a  linearized  version  of  the  nonlinear  problem  defined  by  Equation  6.4. 
1'ne  linearization  is  none  oy  expressing  the  constraint  in  the  form 

ln(o-C)  -  ln(p^  -  C)  =  A  t  +  Lit  2, 

s 

wnerc  i  =  t  -  t„ ,  ana  linearizing  this  expression  with  respect  to  a  correction  e 

o 

of  the  approximation  C: 


p-c  ps  p  2 

In  *- -  =  e  - - +  At  +  Bt  . 

p  -C  (pg-C)  (p-C) 


This  expression  is  linear  with  respect  to  e ,  A  and  B.  We  use  it  in  a  least 
squares  algorithm  as  follows.  First,  we  define  for  each  observed  p^,  t.  the 
quantities 


(p  -c)  (p.-c) 

s  1 


and  formulate  an  objective  function  by 


If  one  considers  the  y.  as  observations,  then  the  normal  equations  for  this 
problem  are 


A  \  w.y.x 
1  1 


+  bN  A w.t^.  +  w.y.x.  = 

/  *  1  1  /  J  111 

E4  V™'  2 

W .  X  ,  +  E  >  W.Y.T  . 

1  1  /  ;  111 

.  +  B  N  w.y.t.  ^  +  e\  \ .  y  .  ^ 

i  /  ,  111  /  v  11 


>  w.y.x., 

ii  i 

Z2 

WiyiT  i' 

=  XWiyiYi- 


The  subroutine  solves  this  system  of  equations  (calling  MTRINDB) ,  replaces  C 
by  C  +  e  ana  iterates  four  times.  For  this  iteration  the  initial  values  are 
A  =  U,  B  =  U,  ana  C  =  min  (0,  p.  -  U.u5  p  ).  In  order  to  avoid  unreasonable 

X  3 

values  of  C  +  e  ,  the  following  restrictions  are  applied  after  each  iteration 

-0.5  p  <  /6"+  e  <  p.  -  0.05  p  . 
s  rimin  rs 

Because  tne  signs  of  the  parameters  C  and  of  the  parameter  c  in  Equation  6.4 
(usea  in  tne  subroutine  EXPON)  are  reversed,  the  negative  value  of  C  is  connmu- 
nicated  as  parameter  C  to  the  calling  routine. 

LQGSC  (Appendix  A) 

This  is  an  auxiliary  routine  for  the  plotting  of  shock  fitting  results. 
The  routine  establishes  proper  plotting  scales  for  logarithmic  plotting. 

LUDATD, LUELMD  (Appendix  B) 

These  are  modified  L4SL  routines  for  the  solution  of  linear  equations. 
They  are  part  of  the  least  squares  package  COLSAC  and  are  included  here 
because  the  use  of  the  LEVEL2  memory  option  makes  a.  special  version  of  the 
routines  necessary. 

MTRIMDB  (Appendix  B) 

This  is  a  matrix  inversion  routine.  It  belongs  to  the  least  squares 
package  COLSAC  and  is  included  here  because  the  use  of  the  LEVEL2  option  makes 
a  special  version  of  this  routine  necessary. 

PFIELD  (Appendices  B  and  C) 

This  subroutine  represents  the  overpressure  field  model  function  defined 
by  Equations  6.1  through  6.3.  It  has  two  entries.  If  entry  PFIELD  is  used 
then  tne  function 


f  = 


(Ps  -  C)e 


A  x  +  3x 


2 


+  C  - 


P 


is  computed  including  its  first  and  second  order  derivatives  with  respect  to 
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t,p,r,  tnc  tiv.  o-'!  roti  rsurc  field  parameters  A^ ,  Ej,  32  and  C^,  and  the 

four  shoe*  parameters  a,  b,  c  ana  a.  If  tnc-  entry  PFIELDC  is  used,  tnen  the 
derivatives  witn  resect  to  the  snock  parameters  are  not  computed.  The  latter 
entry  is  uses  v.s  a  constraint  routine  for  the  overpressure  field  fitting.  The 
entiy  PFIELu  is  used  tor  me  comcutation  of  the  overpressure  field  witr.  cor¬ 
responding  accur_cy  estimates.  Formulas  for  tne  derivatives  of  f  arc  given  in 
heferenev  1,  Section  o.  The  merarchy  of  the  routine  is  shown  in  Figure  6. 

PldJUiX  (App  nuix  3) 

1'nis  is  an  auxiliary  routine  that  permits  one  to  make  an  overpressure 
field  lifting  with  tne  mouel  function  of  Equations  6.1  tnrougn  6.d,  simplified 
oy  A  =  u  anj  =  u.  It  is  useo  as  a  least  squares  constraint  routine  oy 

FiPFLD  if  fitting  with  tne  full  constraint  function  PF1ELD  (entry  PFIELDC)  is 
not  possible  Because  of  algorithmic  difficulties. 

PLDTSH  ( Append i x  A) 


This  is  tne  plotting  routine  to  plot  shock  distance  as  a  function  of  time 
with  corresponding  confidence  limits.  The  plot  also  contains  the  shock 
distance  and  arrival  time  observations. 

PLFFLD  (Appendix  C) 

l'nis  is  tne  plotting  routine  for  tne  flow  field  history  computation 
program.  It  generates  five  history  clots:  overpressure,  particle  velocity, 
density,  dynamic  pressure,  temperature,  and  dynamic  pressure  computed  from  the 
test  velocity.  All  plots  except  for  the  last  one  include  confidence  limits 
anti  tne  velocity  olot  also  contains  the  history  of  the  test  velocity. 

PLPUStl  (Appendix  A) 

This  is  the  plotting  routine  to  plot  snock  overpressure  versus  distance 
with  corresponding  confidence  limits  and  observations. 

PLPT5H  (Appendix  A) 

Plotting  routine  to  plot  snock  overpressure  versus  shock  arrival  time 
with  corresponding  confidence  limits  and  observations. 

PLTFLD  (Appendix  C) 

Tms  routine  is  called  from  FTPFLD  after  adjustment  of  the  overpressure 
field  to  plot  at  the  observation  sites  the  observed  overpressures  ano  the 
aojustea  overpressure  histories.  The  plots  provide  a  visual  check  of  the 
adgustment  results  and  a  comparison  with  the  individual  pressure  history  ad¬ 
justment  clots  oy  PLTPgio. 

PLiLDC  (Appendix  13) 

Inis  routine  is  called  from  tne  main  proqram  for  overpressure  field 
fitting  after  completed  calculations.  The  routine  plots  in  the  r,t-plane  the 


snocx  trajectory,  the  locations  of  the  observed  histories  and  five  particle 
path  lines. 


PLTPAR  (Appendix  B) 

'inis  suoroutine  plots  in  a  log , log-scale  tne  absolute  values  of  the 
overpressure  history  parameters  A,  B  and  C  (see  Equation  6.4,  Section  b.3) 
versus  the  distances  of  tne  histories.  The  plot  provides  a  visual  check  for 
anomalies  of  individual  histories  and  for  the  validity  of  the  assumed 
dependence  of  tne  parameters  on  a  power  of  the  distance. 

PLTPNT3  (Appendix  B) 

Tms  routine  plots  the  overpressure  history  observations  ana  the 
corresponding  individual  history  fitting  results  (first  fitting  step,  Section 
t> . J) .  It  is  called  from  the  main  program  for  overpressure  field  fitting  after 
the  fitting  of  each  individual  history. 

PKIHI3  (Appendix  C) 

This  routine  is  called  from  the  subroutine  FLOFLD  (see  Figure  11)  after 
completed  calculation  of  a  flow  field  history.  It  prints  a  history  table 

2 

containing  t,  p,  u,  p,  u  p/2  and  corresponding  estimates  of  standard  errors. 
PR Id PAR  (Appendix  B) 

This  routine  is  called  from  the  main  program  for  overpressure  field 
fitting  after  the  adjustment  of  all  individual  histories  (see  Section  6.3, 
first  adjustment  step).  It  prints  two  lists  of  the  parameters  A,  B  and  C  with 
their  standard  errors  for  all  histories,  one  in  the  scales  used  for  the 
computation  and  the  other  in  base  SI  units.  The  subroutine  also  computes  the 
exponents  n^,  nQ  and  nc  for  the  overpressure  field  function  and  initial 

estimates  of  the  field  function  parameters  A^,  and  C^.  (These  estimates 

are  improved  uy  FLDGES  before  the  actual  field  fitting  is  started,  see  Figures 
b  anu  7.)  Tne  computation  of  the  exponents  is  done  as  follows: 


Let  LT  oe  a  parameter  determined  at  the  distance  r^.  We  determine  a 
function  L)rn  by  minimizing  the  objective  function 
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The  solution  of  this  system  provides  the  exponent  n  and  D  =  D  sgnD^,  where 
D1  is  the  parameter  corresponding  to  the  smallest  distance  r^  The  exponents 
nft/  nB,  and  n^  are  rounded  to  one  decimal  and  the  D(C)  is  used  as  an  initial 
estimate  of  the  parameter  by  FLDGES. 

PRITST  (Appendix  C) 

This  routine  prints  results  of  the  computation  of  the  test  velocity  (see 
Figures  1,  10  and  11)  by  Equation  2.12.  It  also  calculates  and  prints  the 
2 

dynamic  pressure  u  P/2,  computed  using  for  u  the  test  velocity  instead  of  the 
original  particle  velocity.  The  subroutine  is  called  from  FLOFLD  after  the 
completion  of  calculations  of  the  histories  and  after  calling  UTEST  to  compute 
the  test  velocities. 

PRSHAD  (Appendix  A) 

This  routine  prints  shock  observations,  their  standard  errors  and  the 
corresponding  adjusted  values  of  the  observations.  It  is  called  from  the  main 
program  for  shock  fitting  after  each  adjustment  (see  Figure  2) . 

PRTFLD  (Appendix  B) 

This  routine  prints  all  overpressure  field  observations,  their  standard 
errors  and  their  least  squares  residuals.  It  is  called  from  FTPFLD  after 
completing  the  overpressure  field  adjustment  (see  Figure  7) .  Observations 
belonging  to  different  histories  are  printed  in  different  tables. 

PRTPNTS  (Appendix  B) 

This  routine  prints  the  overpressure  fitting  results  for  individual 
history  adjustments.  It  is  called  from  FITPR  (see  Figure  6)  after  the  least 
squares  adjustment  of  data  from  one  history. 

QFUNCT  (Appendices  B  and  C) 

This  routine  computes  the  exponent  Q  in  the  overpressure  field  function. 
Equations  4.3,  4.4  or  6.1,  and  all  first  and  second  order  derivatives  of  Q. 

It  is  called  from  the  subroutine  PFIELD  which  computes  the  overpressure  field 
(see  Figure  8) . 

READAM  (Appendices  A,B  and  C) 

This  routine  reads  the  data  cards  containing  ambient  conditions  and 
general  data  (first  batch  of  cards),  and  prints  their  contents  in  a 
comprehensive  format.  It  is  called  by  the  main  programs  of  all  three 
programs. 

READFP  (Appendix  C) 

This  routine  reads  the  overpressure  field  fitting  results  (field 
parameters  and  their  accuracies)  in  the  form  of  seven  cards  (see  Section  7.2) 
It  is  called  by  the  main  program  for  history  calculations  (see  Figure  10). 
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KEADPk  (Appendix  B) 

This  routine  is  part  of  the  overpressure  field  fitting  crogram  (sec 
Figure  5).  It  is  callea  from  the  main  program  ana  it  reads  ail  pressure 
history  data  from  cards  described  in  Section  6.2. 

KEADSH  (Appendix  A) 

I'nis  routine  reads  shock  data  from  SHOCK  and  RANGE  cards,  see  Section  5.2 
ana  Figure  2.  The  routine  is  called  from  the  main  program  for  shock  fitting, 
i'ne  input  is  printed  out  by  tnis  routine  in  a  simple  list. 

READS P  (Appenuices  B  and  C) 

This  routine  reaus  tne  cards  with  the  results  from  snock  fitting  (snock 
parameters,  their  error  estimates,  etc.).  The  input  is  described  in  Section 
o.2.  The  routine  is  called  from  tne  main  programs  for  overpressure  fiela 
fitting  and  history  calculations.  After  reading  anc  checking  the  data  for 
completeness,  READSP  prints  the  input  uata  in  a  comprenensive  format. 

KJMBIN  (Appendices  B  and  C) 

This  is  a  Romberg  integration  routine.  It  is  used  by  the  routine  SH0CK2 
to  compute  the  snock  arrival  time  at  a  given  distance  according  to  Equation 
4.2.  The  arguments  of  ROMBIN  have  the  following  meaning. 

F  -  name  of  the  subroutine  that  computes  the  integrand. 

A,B  =  integration  limits 

FINT  =  integral  value 

N3AD  =  error  indicator,  set  equal  to  zero  if  the  integral  has  been 

computed,  and  equal  to  a  non-zero  value  if  the  integral  cannot 
be  computed. 

i’ne  repeated  subdivision  of  the  integration  interval  is  limited  to  2u  steps 
ana  tne  convergence  test  is  on  the  changes  in  the  latest  row  of  extrapolated 

values.  If  at  least  one  relative  change  of  less  that  It)  is  detected,  then 
the  hignest  order  extrapolated  term  is  taken  as  tne  final  result. 

ROMBIN2  (Appendix  C) 

Tnis  routine  is  tne  same  as  ROMBIN.  It  is  used  by  UTEST  to  compute  the- 
integral  given  in  Equation  2.12.  Because  the  integrand  contains  the  function 
t,(r)  which  is  calculated  using  ROMBIN ,  a  second  copy  of  the  general 

integration  routine  was  neeaed. 

ROMULT  (Appendices  A,B,  and  C) 

A  Romberg  integration  routine  for  a  vector  function  witn  nine  components. 
It  is  used  by  the  routines  SHOCK,  SHOCK 2  and  F2SHCK  to  compute  the  shock 

S3 


arrival  tine  anti  its  derivatives  with  respect  to  all  arguments.  (See  Refer¬ 
ence  1,  pages  :'he  integrations  are  cone  simultaneously  for  all  compo¬ 

nents  of  tne-  integrand.  Iteration  eno  is  tested  on  the  last  corrections  of 

all  components.  It  all  relative  corrections  are  smaller  than  1U  then  the 
iteration  stops,  in?  arguments  of  KUMliLT  are  tne  same  as  those  of  RGMBIN. 


SCALAR  (Appendix  Li) 


i;us  i  out  me  is  call  c-u  from  the  mem  program  for  overpressure  field 
fitting  (Pee  figure  o)  .  It  takes  from  tne  CQMIDN/COMPK/  data  belonging  to  one 
pressure  history  (specified  by  nRCASi-,)  and  arranges  the  uata  in  the  format 
requireo  oy  tne  least  squares  program  COLSAC. 

3CALSH  (Appenaix  A) 

Inis  routine  is  calico  from  the  main  program  for  shock  fitting.  (See 
Figure  2.)  It  takes  tne  raw  shock  data  from  COMMON /COMSHDT/ano  arranges  them 
in  arrays  compatible  witn  the  least  squares  program  C0L3MU.  It  also  expresses 
the  cat  a  in  scales  specified  in  the  argument  list  of  the  subroutine.  Some 
special  logic  is  used  to  nandle  observations  with  missing  oata.  Information 
about  such  data  is  communicated  to  the  constraint  routine  FMSHCK  through  the 
CQrttON/C'USF'!/. 

SHOCK  (Appendices  3  ana  C) 

This  subroutine  computes  for  a  given  distance  from  the  center  of  explo¬ 
sion  the  corresponding  shock  overpressure,  arrival  time,  shock  velocity,  part¬ 
icle  velocity  ana  density.  The  formulas  that  are  used  for  the  computation  are 
given  in  Section  4  of  Reference  1.  The  routine  is  called  from  the  main  pro¬ 
gram  for  pressure  fie la  fitting  in  order  to  establish  the  initial  point  of  e 
.history,  ana  also  from  tne  subroutines  3CALPR,  PLTLOC  and  UTCST. 

3HOCK2  (Appendices  13  and  C) 

Tms  routine  computes  for  a  given  distance  r  from  the  explosion  center 
the  corresponding  shoe*  arrival  time  t  and  overpressure  pg,  and  the  first  end 

second  oraer  derivatives  of  t  ana  pg  with  respect  to  r.  The  corresponding 

formulas  are  given  in  Section  4  of  Reference  1.  The  routine  is  called  from 
the  subroutine  QPUNCT. 

SHOCK!  (Apo>--njix  A) 

This  is  the  constraint  routine  for  a  shock  overpressure  model  with  three 
parameters.  It  computes  the  function 

,  i  l 

t  =  or  -nr  -  or-c 

enn  its  donv?  tives.  It  is  used  by  FMSHCK  to  calculate  the  first  component  of 
the  constraint  function  given  by  equation  5.J. 


SHCDER  (Appendices  B  and  C) 


This  routine  computes  for  a  given  distance  r  from  the  center  of  the 
explosion  the  shock  arrival  time  tg,  the  shock  overpressure  pg/  and  all  first 

and  second  derivatives  of  tg  and  ps  with  respect  to  r  and  the  shock 

parameters.  The  routine  uses  the  subroutine  F2SHCK  to  compute  t  and  its 

derivatives.  It  is  called  from' the  subroutine  QFUNCT. 

SHTINT  (Appendices  B  and  C) 

This  is  the  integrand  in  the  integral  given  in  Equation  4.2  for  the 
calculation  of  the  shock  arrival  time. 

STRBEG  (Appendices  B  and  C) 


This  routine  computes  the  initial  values  for  the  differential  equation 
systems  given  in  Equations  3.1  and  3.4  and  the  derivatives  dts/dd  and  dus/dd 

at  the  shock.  (us  is  the  particle  acceleration  at  the  shock,  dus/d0  is  the 

initial  value  of  the  right  hand  side  of  the  second  Equation  3.4.)  It  also 
calculates  an  expression  DFTN,  which  is  part  of  the  right  hand  side  of  the 
second  Equation  3.4.  The  routine  is  called  from  PLOTLOC  and  FLOFLD  to  initiate 
the  numerical  integration  of  Equations  3.1  and  3.4.  The  calling  program 
provides  the  shock  distance  r  =  S0EIN(3)  and  STRBEG  uses  the  following 
formulas  to  calculate  the  other  variables.  (The  formulas  are  derived  in 
Reference  1.): 

The  shock  overpressure  is  computed  by  Equation  5.1: 

S0UN(2)  =  Ps  =  a/r  +  b/r2  +  c/r3. 

The  shock  parameters  a,  b,  c  are  taken  from  CQW40N/CCMSMK/.  Let  p  be  the 

o 

ambient  pressure,  pq  be  the  ambient  density,  7  be  the  ratio  of  specific  heats, 
cq  be  the  sound  speed, 

rL  -  (y  +  D/(2ypo), 


and 


r2  =  (7-  l)/(2ypo). 

Then  the  shock  velocity  is 

U  =  co  a  +  I-J  ps>  1/2. 

The  density  behind  the  shock  is 

solin(5)  =PS  «  PQ  (i  +  r:Ps  )  /(I  +  r2ps) 


and  the  particle  velocity  behind  the  shock  is 


SOLIN (4)  =  us  =  ps/(Upo). 

The  shock  arrival  time  SOLIM(l)  =  t  is  computed  by  calling  the  subrou¬ 
tine  F2SHCK  which  evaluates  the  integral  Equation  4.2.  The  acceleration  ug  is 
given  by 


The  derivatives  with  respect  to  the  model  parameters  6  are  calculated  as 
follows 

mr>  t 

XPP 
UPP 

ps0  =  3ps/30  =  [c2o  (i  +  rxps)  (1  +  r2Ps)]  -1  3ps/ae 


=  3ts/30  provided  by  F2SHCK 

=  3r/30  =  0 

=  3u  /30  = 
s 

=  US  [1/ps  "  °-5V(1  +  I’lps)]  3ps/8B 


=  ROFACT  .  3pg/30 


UPTP  =  3us/30 
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The  derivatives  of  ps  with  respect  to  r  and  P  are  easily  computed.  The 
above  mentioned  expression  DPIN  is  defined  by 


dpin  =  ps0/ps  -  ~ 

o  59 


3ps/80 


56 


STRLIN  (Appendices  B  and  C) 


This  routine  carries  out  the  numerical  integration  of  the  differential 
equation  systans  given  in  Equations  3.1  and  3.4.  Initial  values  for  the 
integrals  are  provided  by  the  calling  program  which  also  specifies  a  time 
increment  DT  for  which  the  results  are  needed  and  an  end  time  for  the 
integration.  Ttfe  actual  integration  increment  is  DTS  =  0.2  DT,  but  results 
are  stored  at  DT- increments.  The  numerical  integration  is  done  using  a  two 
level  fourth  order  scheme  for  Equation  3.1  and  a  two  level  third  order  scheme 
for  Equation  3.4.  The  schemes  are  described  in  Reference  1,  Section  3.  The 
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important  results  of  the  integration  are  the  flow  variables  (t,p,r,u, p  ,pu  /2) 
which  are  stored  as  a  six  component  vector  in  SLINA,  and  the  corresponding 
variance  covariance  matrices  at  each  computed  node.  These  6x6-matrices  are 
stored  in  VSLINA.  The  values  of  dr/d0  and  3u/0g  ,  that  is,  the  solution  of 
Equation  3.4,  are  only  needed  to  calculate  the  variance-covariance  matrices. 
They  are  stored  internally  only  at  two  current  integration  levels  in  the 

arrays  XP  and  UP,  together  with  the  other  quantities  (u,  u,  u  and  u^  in  U,  UT, 

UTT  and  OTP)  that  are  needed  for  the  integration.  The  subroutine  STRLIN  is 
called  from  PLTLOC  and  FLOFLD  (See  Figure  11). 

UTEST  (Appendix  C) 

This  routine  computes  test  velocities  by  evaluating  the  integral  given  in 
Equation  2.12  (see  also  Figure  1).  It  is  called  from  FLOFLD  (Figure  11)  to 
evaluate  the  integral  at  specified  tg-values.  The  corresponding  shock  points 

provide  the  additive  term  in  Equation  2.12  and  are  obtained  by  calling  the 

subroutine  SHOCK.  Because  SHOCK  computes  shock  values  for  given  r,  but  t  is 

& 

specified,  the  proper  r-value  is  found  by  a  regula  falsi  iteration.  The 
evaluation  of  the  integral  is  done  by  calling  the  subroutine  R0MBIN2. 

OTIOT  (Appendix  C) 

This  is  the  integrand  in  Equation  2.12.  The  routine  is  used  by  OTEST  as 
argument  when  calling  the  R0MBIN2  quadrature  to  evaluate  the  integral. 
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Appendix  A 

Shock  Fitting  Program  BLAFS 
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PROGRAM  SHOKF IT ( INPUT ,OUTPUT, T APE6- OUTPUT, TAPfc 13 ) 

C 

C  MAIN  PROGRAM  FOR  SHOCK  FITTING 
C 

DIMENSION  X(5,50),R(5,5,50I,ALABEL(2»50),LSTXC50)»PARSC10), 

ANXNK (2,50), XC (5,50), C (5,50), LSTNC 50 1, VP ARS ( 10, 101 , E RP ARS ( 10 ) , 
BPARSD(IO) ,VPARSD( 10, 101, TITLE! 3) 

C  THESE  DIMENSIONS  ALLOW  TO  TREAT  UP  TO  50  SHOCK  OBSERVATIONS 
C  CORRESPONDING  LIMITS  ARE  IMPLIED  BY  ARRAYS  IN  SUBROUTINE  READSH 
C 

25  CALL  READAM  (SCOIS, SC PRE, SC T IM, TITLE, NBAD > 

C  READ  AMBIENT  OATA 

I  FIN ft  AD *NE  *0) STOP 
C 

CALL  READSH  ( NRSHOK, TITLE ) 

C  RE  AO  ALL  SHOCK  OBSERVATIONS 
IF (NRSHOK  «LE«0)ST0P 
C 

CALL  SCALSH  ( SCOIS, SC PRE , SC  TIM, X, R, AL ABEL, LSTX,NXNK, NRSHOK, NBD ) 
IFCNBO.NE.OIGQTO  25 

C  THIS  STORED  SCALED  OBSERVATIONS  IN  LSQ  ARRAYS  X  THROUGH  NRSHOK 
C 

PARS ( 1 ) *1 •  S  P ARS(2 )•!•  S  PARS<3)-1.  t  PARS(4)-0. 

C  INITIAL  VALUES  OF  SHOCK  FITTING  PARAMETERS 
C 

DO  65  KA  -  1,4 

C  MAKE  4  ADJUSTMENTS:  PRESSURE,  PRESSURE ♦DISTANCE, 

C  PRES S UR E>D  1ST ANCE* TIME,  PRESSURE^TINE 

C 

CALL  F I TSH ( SCOIS, SCPR E, SC T IM, K A, X,R,AL ABE L,LSTX,NXNK, NRSHOK, PARS, 

1  NP, XC,C, LSTN»NRGO»  ERZStVPARS, ERPARS, NBAD) 

C 

C  NEXT  PRINT  ADJUSTED  OBSERVATIONS 

CALL  PRSHAD(SCOIS,SCPRE,SCTIN,KA,XC,C,R,LSTN,ALABEL,NRSHOK, 

A  TITLE) 

C 

IFINBAD.NE.OIGOTO  25 
C 

C  NEXT  COMPUTE  DIMENSIONAL  VALUES  PARSO  OF  THE  PARAMETERS 

CALL  OIMP ARS( KA, SCOIS, SCPRE, SC  TIM, P ARS, NP,VPARS»ERZS,PARSD, VPARSD, 
A  TITLE) 

C 

SCDI  -  1.  $  SCPR  •  1.  *  SCT I  -  1. 

C  THESE  SCALES  CORRESPOND  TO  PARSD  AND  VPARSD 
C  THEY  WILL  CAUSE  PLOTTING  IN  SI  BASE  UNITS 
ERFACT-3. 

C  ERROR  FACTOR  FOR  PLOTTING  OF  CONFIDENCE  LIMITS 
C 

CALL  PLPDSH(KA,SCDI,SCPR, SCTI, NRSHOK, PARSO, NP, VPARSD, 

AERZS  »  ERFACT ) 

C  PLOT  PRESSURE  OVER  OISTANCE 

CALL  PL PT SH (K A, SCO  I, SCPR, SC T I, NRSHOK, PARSD, NP, VPARSD, 

AERZS, ERFACT) 

C  PLOT  PRESSURE  OVER  TIME 

CALL  PLOT SHCKA, SCO  I, SCPR, SCT I, NRSHOK, PARSD,NP,  VPARSO, 

AERZS, ERFACT) 

C  PLOT  DISTANCE  OVER  TIME 
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oooooooooooooriooooooooo 


SUBROUTINE  RE ADAM! SCO  1ST. SC PRE S# SCT IME, TITL E» NBAD ) 

THIS  ROUTINE  READS  TITLE  #  PLOTLABEL  AND  DATA  CARDS  DESCRIBING 
AMBIENT  CONDITIONS  AND  THE  CHARGE 

FIRST  TWO  CARDS  ARE  MANDATORY  AND  ALPHANUMERIC  (TITLE  AND  PLOTL ABEL ) 
THE  REST  OF  THE  CARDS  HAVE  THE  FORMAT  (2A10.6E10. 3) 

CHARGE  CARD  IS  MANDATORY 

IF  AMBIENT  DATA  ARE  NOT  PROVIDED  THEN  STANDARD  AIR  WILL  BE  ASSUMED 

SEQUENCE  OF  MANDATORY  INPUT  CARDS 
TITLE  CARD  (ALPHANUMERIC) 

PLOTLABEL  CARD  (ALPHANUMERIC) 

CHARGE  CARD  *  VOLUME »  ENERGY#  HIGHT#  ERROR  OF  HIGHT 

THE  FOLLOWING  ARE  OPTIONAL  INPUT  CARDS  IN  ARBITRARY  SEQUCNCE 
AMBIENT  «  P, TEMPERATURE#  GAMMA#  MOLAR  MASS 

DEFAULT  VALUES  CORRESPOND  TO  A  STANDARD  AIR 
SCALES  «  SCALES  OF  R»P»T  TO  BE  USED  IN  COMPUTATIONS 
DEFAULT  VALUES  ARE  COMPUTED  AFTER  STATEMENT  1110 
PLOTTING  OATA  -  ERROR  FACTORS  FOR  THE  PLOTTING  OF  CONFIDENCE 
LIMITS  IN  HISTORY  PLOTS 
DEFAULT  VALUES  ARE  FACTORS  2.0  FOR  ALL  PLOTS 

END  OF  INPUT  IS  INDICATED  BY  A  BLANK  CARD 

DIMENSION  TITLE! 3) 

DIMENSION  D ( 8  )»  AMSTAR ( A ) 

COMMONS AMBCHASAIRPR»AIRTEM,AIRGAM# A IRMOL#CHAR VO# CHAREN, 
ACHARHI»CHARHER 
COMMONSPLQTSPO(6)»PLABL(6) 

DATA ( TITL  -10HTITLE  )#  ( PL AB-10HPL0TLABEL  ) 

DATA  (BLANK-10H  ) , ( AHB-10H AMB I  ENT  ) 

DATA  (CHA«10HCHARGE  ) 

0ATA(PLT«10HPL0TTING  0I#(SCAL-10HSCALES  R#P> 

15  FORMAT! 1H1# 10X#  20H INPUT  READ  BY  READAM# / # 1H  » 10X, 20( 1H- ), S ) 

25  FORMAT ( 8A10 ) 

26  FORM  AT ( 1H  #10X#8A10) 

35  F ORM AT ( 2A10»6E10. 3 ) 

36  FORMAT ( 1H  # 10X# 2 A10»6 ( 2X, 1PE10. 3) ) 

C 

PD(1) -2.0 

C  DEFAULT  VALUE  FOR  PLOTTING  ERROR  LIMITS  IN  PRESSURE  HISTORIES 
PD(2) «2.0 

C  DEFAULT  VALUE  FOR  PLOTTING  FIELD  HISTORIES  CP»V»RHO#V**2*RHOS2.) 
AIRPR-101325.0  $  AIRTEM-293.0  t  AIRGAM* 1. A 

AIRMOL-O. 02896  %  AIRDEN- ( AIRMOL SB .31631* ( AIRPR/AIRTEM ) 

C  THESE  ARE  STANDARO  AIR  DEFAULT  VALUES  FOR  AMBIENT  CONDITIONS 
C 

NSCAL-0  $  NAMSTAR-0 
NAMB-0  S  NCHA-0 
DO  37  J-l#6 
37  AMST  AR( J) «1H 
PRINT  15 
DO  66  KK-1,2 
READ  25#(0(JI#J-1#8) 

PRINT  26#  (0(J)»J>1#8) 

IF (0(1). EQ. TITL  )  GOTO  62 
TF(0(  D.EQ.PLAB)  GOTO  66 


■v 


60 


65 


70 


75 


30 


35 


JO 


)5 


)0 


)5 


10 


PRINT  58  $  NBAD-1  $  RETURN 
C 

52  DO  53  K  A*  1 ,  3 

53  TITLE!KA)-0!KA*1) 

GOTO  56 

55  00  55  K  A*  1  #  5 

55  PLA8L !KA) -DIKA+l ) 

56  CONTINUE 
C 

57  READ  35,!D!J),J-1,8) 

PRINT  36,  !D!J  If  J»1,B> 

I F (0  C 1)  .EQ.AMBJGOTO  55 
IF1DI 1) .EQ.CHAIGOTO  65 
IF1D!  D.EQ.PLT)  GOTO  66 
IF!D!1) .EQ.SCAL)  GOTO  68 
lF!Dil).EQ. BLANK  I  GOTO  69 
575  PRINT  58  $  NBAD«2  *  RETURN 

58  FORMAT! 1H 0, 10X,13H INVALID  INPUT) 

C 

55  IF(NANB.E0.1)G0T0  575 

C  ONLY  ONE  AMBIENT  DATA  CARD  WILL  BE  CONSIDERED 
NANB-1 

IF(D< 3).GT.O. )AIRPR»D!3)  $  I F I D 1 5 ) . GT . 0. ) AI RTEM-D < 51 
IF  ID! 5) .GT.O. >AIRGAM«D!5)  t  IF ( D( 6) .GT . 0. ) A IRHOL-D! 6) 

C  IF  INPUT  IS  ZERO  THEN  USE  AIR  DEFAULT  VALUES 
00  57  K A* 1»  5  $  AMST AR1KA) -1H 

IF!D!KA*2) .GT.O.)  GOTO  57 
AMSTAR(KA)-1H*  S  NAMSTAR-1 

57  CONTINUE 

Ai. .DEN-(AIRM0L/8.3153)*!AIRPR/AIRTEM> 

GOTO  57 
C 

65  IFINCHA.EQ.DGOTO  575 

CHARV0-D13)  *  CHAREN-DI5) 

CHARHI-DI5)  %  CHARHER-0!6) 

NCHA-1 
GOTO  57 
C 

66  DO  67  KA*1,6 

67  P0!KA)«D!KA*2) 

GOTO  57 

C  PLOTTING  DATA  CARD  SPECIFIES  PLOTTED  OUTPUT 
C  PD  !  1 )  •  ERROR  FACTOR  FOR  PRESSURE  HISTORIES 
C  PO !2 )  *  ERROR  FACTOR  FOR  OTHER  FLOW  HISTORIES 
C 

68  NSCAL-1 

SCO-013)  *  SCP-0( 5)  S  SCT-D! 5 ) 

C  SCALE  CARD  OVERRIDES  SCALES  COMPUTED  FROM  AMBIENT  AND  CHARGE  DATA 
IF(SCD. GT.O.. AND. SCP. GT.O.. AND. SCT. GT.O. )  GOTO  57 
NSCAL-0  S  PRINT  68i 

681  FORNATUH  , 10X, 36HN0N-P0S ITIVE  SCALES  ARE  NOT  ACCEPTEO) 

GOTO  57 
C 

69  IF(NCHA.EQ.O.OR.NAMB«  EQ.O )  PRINT  70 

70  FORMAT! 1H0, 1 OX, 16H INCOMPLETE  INPUT) 

75  PR  IN T 106, !TITLE!J),J-I,3) 

106  FORMAT! 1H1,/,IH  , 10X, 5HE VENT, / , 1H  ,10X,  5! IH- ) , /, 1H0, 15X, 3A10, / / ) 
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PRINT  107 

107  FORMAT! 1H0, 10X, 18HAMB IENT  COND I T I ONS» /» 1H  .. 

IF(NAHB.EQ.O)  PRINT  1071 

1071  FORMAT! 1H0, 10X,  36HTHE  FOLLOWING  AMBIENT  CONDITIONS  ARt, 

A  /»1H  , 10X, 27HST  AND AR  D  AIR  DEFAULT  VALUES./) 

PRINT  108,AHSTAR!ll,AIRPR,AMSTARm,AIRTEM,  AMSTARI3) , AlkSAM, 

A  AMSTARI4I,  AIRMOL 

108  F0RMATI1H  .13X.A1.1X.  8HPRESSURE.11X.7HAIRPR*.  1PE12.5,<*H  PA,/, 

A  1H  ,13X,A1,1X,11HTEMPERATURE»8X»7HAIRTEN«,1PE12.5,3H  *,/, 

B  1H  »  13X.A1.1X.16HSPEC.  HEAT  R AT  IQ, 3X » 7HAIRGAM* , 1PE 1 2. 5, /, 

C  1H  , 13X, A1.1X.10HM0LAR  M AS S, 9 X, 7HA IRMOL*, l PE  1 2 . 5, 9H  KG/MOLE,/) 
A  IRS  NO* SORT! AIRGAMPAIRPR/AIRDEN) 

PRINT  109, AIRSNO.AIROEN 

109  FORMAT ( 1H  , 15X,11HS0UND  SPEED, 8X.7HAIRSN0*. 1PE12.5, 5H  M/S,/, 

A  1H  , 15 X. 7HDENSITY, 12X.7HAIRDEN*. 1PE12.5.9H  KG/MP*3,/> 

IFINAMSTAR.EO.il  PRINT  1081 

1081  FORMAT ( 1H  , 13X, 35H*  THE  STARRED  DATA  ARE  STANDARD  AIR, 

A  15H  DEFAULT  VALUES,/! 

IFINCHA.EQ.il  GOTO  1100 
N  8  AO  *  A  $  PRINT  1101, NBAO  S  RETURN 
1101  FORMAT! 1H0,10X, 29HRETURN  FROM  READAM  WITH  NBAD«,I2, 

A  33H,  BECAUSE  CHARGE  DATA  ARE  HISSINGI 
C 

1100  PRINT  110 

110  FORMAT! 1H0, 10X, 18HCHARGE  DESCRIPTION, /,1H  , 10 X. 1 8 ! 1 H- ) , / ) 

PRINT  111,  CHAR VO, CHAREN 

111  FORMAT ! 1H  , 15X, 13HCHARGE  VOLUME, 6X, 7HCH ARVO*, 1PE 12. 5, fcH  M**3,/, 
A  1H  , 15X, 13HCHARGE  ENERGY, 6X» 7HCHAREN-, 1PE12. 5, 3H  J,/| 

SCDIST-CHARVO**! 1./3. I 
PRINT  1110.CHARHI, CHARMER 

1110  FORMAT! lH  , 15X, 1 6HCHARGE  ELEVATION, 3X, 7HCH ARHI* »1PE12.5»AH  ♦-  , 

A  1  PE  12. 5,  3H  M,  /  I 
SCTIME* SC OIST/AIRSNO 
SCPRES*AIRPR 

SCEVE N* CHAREN/! CHAR VO PAIRPR I 
PRINT  112 

112  F0RMAT!1H0,10X,7HSCALING,/,1H  , 10X, 7! 1H-) , / ) 

PRINT  113,SCDIST,SCTIME,SCPRES,SCEVEN 

113  FORMAT! 1H  , 15X,12HLENGTH  SC  ALE , AX, 20HSCDI3T -CHARVO**! 1/ 3 1 , 

A  2X,1H-,1PE12.5,3H  M ,/, 

B  1H  , 15X, 10HTIME  SC ALE,6X, 20HSCTIME-SCDI ST/ AI RSND, 

C  2X» 1H*,1PE12.5,3H  S,/, 

D  1H  ,15X, 1AHPRESSURE  SCALE, 2X, 13HSCPRES-AIRPR  , 

E  9X, 1H*,1PE12.5,AH  PA,/, 

F  1H  , 15X, 1AHSCALE  OF  EVENT, 2 X, 21HCH AREN / I CHARVO* AIRPR ) , 

G  1X,1H*,1PE12.5»/| 

IF!SCEVEN.EQ.O.OIPRINT  11 A 

HA  F  ORM  AT!  1H  ,  15X,  30HEVENT  CANNOT  BE  SCALEO  BECAUSE, 

A29H  CHAREN  IS  NOT  GIVEN  BY  INPUT,/) 

IFINSCAL. EQ.OI  GOTO  115 

C  USE  SCALES  FROM  SCALE  CARD  IF  SUCH  A  CARD  WAS  READ 
SCDIST«SCD  %  SCPRES  *SCP  J  SCTIME-SCT 

115  PRINT  116, SCDIST, SCTIME, SCPRES 

116  FORM  AT ! 1H  ,////, 1H  , 1  OX, 27HSC ALES  USED  IN  THIS  PROGRAM,/, 
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A  1H  ,10X»27UH-),//»lH  ,  20X,  16HLENGTH  SCALE  »»1PE12.5,3H  «,/, 

B  1H  » 20X» 16HTIME  SCALE  -»1PE12.5»3H  S 
C  1H  > 20X» 16HPRESSURE  SCALE  -,1PE12.5»4H  PA) 

175  N  B  AD  •  0 

RETURN 
ENO 
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SUBROUTINE  RE ADSHt NRS H, T I T > 
THIS  RE  AOS  SHOCK  DATA 


ALL  CARDS  HAVE  THE  FORMAT  (  2 AlO, 6( E 10 . 3 » ) 

SHOCK  CARD  CONTAINS  L AB E L , T I  ME, E RROR  OF  T,  PRESSURE,  ERROR  OF  P 
RANGE  CARD  CONTAINS  LABEL,  X,  ERROR  OF  X,  MIGHT,  ERROR  Of  H 
THE  SEQUENCE  OF  THE  INPUT  CAROS  IS  ARBITRARY 

END  OF  INPUT  IS  INDICATED  BY  A  BLANK  CARD 

C0MM0N/C0MSH0T/TPXH(4,50),ERTPXH(4,50),TITLE(3),ALAB(2,50) 
T,P,X,H  OF  SHOCK  OBSERVATIONS.  CORRESPONDING  ERRRORS 
DIMENSION  TITO), 0(6) 

DATA( NMAX»50) 

MAXIMUM  NUMBER  OF  SHOCK  DATA  THAT  CAN  BE  STORED 


DATA  (RANGE  *10HRANGE 
A, { 3L  ANK*1 OH 


), ( SHOCK *1  OHS HOCK 


DO  10  J«l,  3 
TITLE (J)-TIT(J) 

NRSH-0 

00  12  J«l,50  S  ALAB (1, J I-BLANK 
DO  11  K»l,4  $  ERTPXHU,  J)«0. 

TPXH(K,J)»0. 

ALA3(2, JI-BLANK 
FORMAT! 2A10, 6(610. 3) ) 

FORMAT ( 1H  ,5X,2A10,6( 2X,1PE 12.51 ) 

PRINT  18 

FORMATdHl,  10X,20HINPUT  READ  BY  REAOSH,//) 
CONTINUE 

READ15, (D(J),J»1,6) 

PRINT  16, (0(J),J«l,6) 

IF(0<1I.FQ. BLANK)  GOTO  75 
I F ( D <  21  .EQ. RANGE)  GOTO  35 
IF(D(2).EQ. SHOCK)  GOTO  55 
PRINT  28 
STOP 

FORMAT ( 1H  »10X»13HINVALID  INPUT) 


DO  37  KA*1,NMAX 
IF(KA.GT.NRSH)  GOTO  40 
IF(0(1).EQ.ALAR(1,KA) )  GOTO  42 
CONTINUE 
GOTO  85 
NRSH»NRSH*1  $  K A*NR  SH 
A L AB ( 1, KA ) «D ( 1 )  t  A L AB ( 2 , K A ) -TIT( 1 ) 
TPXM(3,KA)-D(3)  5  E RTPXH( 3, K A )«D( 4 ) 

TPXH(4,KA»«0(5>  S  E RTP XH ( 4, K A ) «0 ( 6) 
GOTO  27 


DO  57  K A*  1,  NMAX 

IF(KA.GT.NRSH)  GOTO  60 

IF(D(  l)  .EQ.ALABt 1,KA)  )  GOTO  62 

CONTINUE 

GOTO  85 

NRSH-NRSH+1  S  KA-NRSH 


SUBROUTINE  SC ALSHI SCO  I, SC  PR, SC TI, X, R, AL AB, L ST  X  *  N KNK, 

ANRSHOK, NB AO  I 

C  THIS  STORES  PROPERLY  SCALEO  SHOCK  DATA  IN  l SQ  ARRAYS 
C  THE  SCALES  ARE  PROVIOED  BY  THE  CALLIN6  PROGRAM 
C  XC1I-PRESSURE,  X  C  2  J  *DI  ST  ANCE,  X(3)*TIME 
C  IF  PRESSURE  DATA  ARE  MISSING  THEN  XC1)»TIME 
C 

DIMENSION  XC5»50)»R<5»5,50)»AIAB<2,50)»LSTX(50>»NXNK{2,50> 

C 

COMMON/AMBCHA/AMPR,AMTEM, GAM, AMBMOL,CHVOL» CHEN, CHH, ECHH 
C  OMMON/COMSHOT/TPXH (4 , 50),ERTPXH(4*50),TITLE13)»AL8(2»50) 

C  THIS  CONTAINS  RAW  INPUT 
C 

COMMON/CMISFM/MISPDTI 3, 50 > , DI S TN ( 50 > , NODIST, SCOO 
C  THIS  INDICATES  FOR  SUBROUTINE  FMSHCK  MISSING  P,D  OR  T  BY  1  IN  MISPDT 
C  NODIST. NE.O  INDICATES  THAT  ERROR  FREE  DISTANCES  ARE  IN  OISTN 
C 

COMM ON /CF  2DER/GAMCAP»SNDSPD,CPAR(4)»0MINSC,SCD,SCP,SCT 
C  /CF20ER/  IS  USED  BY  CONSTRAINT  ROUTINES  F2SHCK  AND  F2DER 
C 

COMMON/CMPLSH/PMIN»PMAX,DMIN,DMAX»TMIN, TMAX 
C  THE  EXTREME  VALUES  IN  CMPLSH  WILL  DETERMINE  PLOTTING  LIMITS 
C 

GAMCAP*({ l.+GAMI / <2.*GAM) I* ( SC  PR/ AMPR ) 

SNDSPD*SQRT (GAM* AMTEM*8. 31431/ AMBMOL l*(SCTI/SCDII 
SCO*SCDI  t  SCP-SCPR  S  SCT-SCTI 
C  THIS  TELLS  IN  WHAT  UNITS  GAMCAP  AND  SNDSPD  ARE  EXPRESSED 
C 

PMIN-0  $  PM A X*0  $  0MIN*0  $  DMAX-0  S  TMIN-0  S  TMAX-0 
NRS*0 
C 

SCDD-SCDI 

DO  55  KA*1,NRSH0K 

IF(TPXHC3,KA).GT.O..AND,ERTPXHC3,KA).GT.O. )GOTO  15 
M I  SPOT! 2, K A  I *1  S  LSTXIKAJ-1 
M  ISP  OT  ( 1,  K  A)  *0 

IF(TPXH(2,KA).LE.O. .OR.ERTPXHt 2, K A) .LE.O. )  MISPDTC1,KA»-1 
M ISP  DTI  3, K A )  *0 

IF(TPXH(1, KA). LE.O.. OR. ERTPXH(1,KA). LE.O.)  MI  SPOT C 3, KA J » 1 
GOTO  45 

15  X(2,KAI*SQRT(TPXHI J»K  A ) **2>ICHH— T  PXH(4»KA))**2) 

R  <  2, 2, KA) » (TPXH(3,KA)*ERTPXH( 3,KA»/X(2, KA) )**?♦ 

A( (CHH— TPXH(4»KAI )/X(2,KA) ) ** 2* C EC HH**2+ERTP XH ( 4, KA ) **2 ) 

C 

IF(DMIN.GT.O.)GOTO  16 
DMIN*X(2,KA)  $  DM AX  *DMIN 

16  DMIN* A  MIN  1 ( DM  IN, X ( 2,K A ) )  $  DMAX-AM A  XI < ON A X, X ( 2 > K A I) 

C 

X(2,KA)-X(2,KA)/SCDI 

R  <  2, 2»K A) «R(2,2,KA)/SCDI**2 

DISTN(KA)-X(2,KA) 

R( 1, 3,KA) *0  $  R<  3, 1,K  A ) *0  $  R(2,3,KA)*0  $  R(3,2,KA)*0 
R ( 1, 2 ,KA) *0  $  R  ( 2, 1,K A ) *0  $  LSTXtKA)*0  $  M I SP DT ( 2,K A ) *0 
J-l  $  MIS  PDTl 1,KA) *1 

IF(TPXH(2,KA).LE.0..0R.ERTPXH(2,KA).LE.0.)G0T0  25 
C 


XC1»KA»»TPXHC2>KA»/SCPR 

R<1,1»KA»«(ERTPXH<2,KA)/SCPRI**2 

IFIPMIN.GT.O. IGOTO  22 
PMIN«TPXH(2,KA>  $  PMAX-PMIN  t  GOTO  25 
22  PMIN»AMINUPMlN,TPXH(2,KAI>  *  PMAX-  AMAXK  PMAX»  TPXHC  2,KA> » 

25  IF(TPXHC1,KAI.GT.0..AN0.ERTPXH(1,KA>.GT.0.»60T0  35 

MISPQT(3»KAI“l  $  IF<NISPOT<1,KA).NE.05CSTX<KAJ-1  $  GOTO  45 
35  X( J,KA»*TPXHC1,KA)/SCTI 

RU#  J,KA>«CERTPXH<1»K  A)/SCTII**2 
MISP0T<3»KA)«0 

IFtTMAX.GT.O. I GO TO  38 
TMIN«TPXH(1»KA)  $  TMAX-TMIN  *  GOTO  45 
38  THIN*  AMIN  1 ( TMIN»  TPXH( 1»KA I )  t  TMA X« AM  AX  1 ( TM AX, TPXH< 1 ,K A ) ) 

45  ALAB(l,KA)*AlB(l»KA)  $  AL AB ( 2, KA) -ALB ( 2»K A » 
IF<LSTX(KA».EO.O)NRS»NRS«-l 
55  CONTINUE 

DMINSC-DMIN/SCDI 

NBAD-0  $  IF(NRS.EQ.O)NBAO«l 

RETURN 
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SUBROUTINE  FITSHC  SCO* SCP, SC T, K A, X,R, Al ABEL , LS TX, NXNK,NRSCK, PAR, NP, 

1  XC,C»LSTN»NRGD»ERZ»VPAR,ERPAR»NBAD) 

C  THIS  FITS  SHOCK  DATA  ACCORDING  TO  MODIFIER  KA 
C 

5  C  ROUTINE  USES  LSQ  PROGRAM  COLSMUA  FOR  FITTING 

C 

C  SCO,  SCP,  SC  T  -  SCALES  IN  TERMS  OF  WHICH  THE  ARGUMENTS  X  IS  EXPRESSED 
C  KA  *  MODIFIER  FOR  FITTING 

C  KA«1  -  FIT  PRESSURE.  KA*2  -  FIT  PRESSURE+OISTANCE 
10  C  K  A  *3  -  FIT  PRESSURE+-OIST  ANCE  +  T I  ME  .  KA«A  -  FIT  PRESSURE*TIME 

C 

C  X ( 5, 50)  *  LEAST  SQUARES  DATA  ARRAY 

C  X ( 1) *PR  £  SSURE  »  X (2 ) *OIST  ANCE,  X(3I*TIME 
C  IF  PRESSURE  DATA  ARE  MISSING  THEN  X( 1 ) *T IME 
15  C 

C  THE  REMAINING  ARGUMENTS  ARE  STANDARD  LEAST  SQUARES  ARGUMENTS 
C 

DIMENSION  X(5»  50  )  ,  R  ( 5 , 5,  5  0 )  ,  ALABEH2,  50 ) , LS TX < 50 )»NXNK( 2, 50 > , 

AP  AR(  1 0 )  > XC  (  5,  50 )  » C  (  5,  50)  ,LS  TN (  50)  »  VPAR  ( 10, 10)  >  ERP AR  ( 10 ) 

20  C 

DIMENSION  XA(5,50),RA(5,5, 50), XCA < 5, 50) »C A< 5, 50 > 

DIMENSION  WORK(AOOO) 

C 

COMMON/CMISFM/MISPDTI 3,50 ) ,01 S TN( 50 ) , NODIST ,SCDD 
25  C0MM0N/CF2  OER/GAMCAP, SNOS PD, C P AR ( A) , ALOW, SCDI , SCPR, SCTI 

C  MISPOT  INDICATES  MISSING  P,0  OR  T  BY  CORRESPONDING  ONES 
C  NODIST. NE.O  INDICATES  THAT  ERROR  FREE  DISTANCES  ARE  IN  DISTN 
C  BOTH  COMMON  BLOCKS  ARE  NEEEDEO  BY  CONSTRAINT  ROUTINES 
C 

30  EXTERNAL  FMSHCK 

C 

DATAINWORK-AOOO) 

C  MAXIMUM  DIMENSION  OF  WORK,  NEEDED  BY  COLSMUA 
C 

35  SNDSPD-SNOSPD*SCOI*SCT/(SCTI*SCD) 

GAMC AP-GAMCAP*SCP/SCPR 
ALOW “ALOW *SCOI/SCD 
SCOI-SCD 
SCTI-SCT 

AO  SCPR-SCP 

Sl-SCDD/SCD 
DO  10  1*1, 50 
OISTNC I)-DISTN(I)*S1 
10  CONTINUE 
A5  SCDD-SCD 

C  NOW  ALL  COMMON  BLOCK  DATA  ARE  EXPRESSED  IN  SCALES  GIVEN  BY  THE  ARGUMENT 
C 

NX*MIN0(KA,3)  $  NODIST-O  *  ITYPE*0 
NP*MAX0<3,KAU>  $  NP* M INO < N P , A > 

50  C 

DO  A 5  KB* 1 , NRSCK  *  IF ( LS T X( K B )  .EQ. 1 )GOTO  A5 
C 

00  25  K C* l , 3  *  XA(KC»KB)*X(KC»KB) 

XCA(KC,K8)*X(KC,KB)  %  DO  25  KD»1,3 
55  25  RA(KC,KD,KB)«RCKC,KD,KB) 

C 

NXNK( 1,KB)*NX  $  LSTX(KB)*0 

71 


60 
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70 


75 


80 


85 


90 


95 


NXNK<2»KBI-MAX0<1»KA-1>  t  I F ( NXNK( 2#KB I . GT. 2 ) N XNK ( 2 , K8 ) * 2 
IF<KA<EQ<1 < AND. MI SPOT <l#KB) <NE.0)LSTX<KB)-2 
IFIKA.EQ. 2*  AND*  HI  SPOT < 1#  KB ) <NE.0)LSTX<KB)-3 
IF<KA<LE<2 >GOTO  45 
IF<KA<EQ<3IGGT0  35 
C 

NODI S  T- 1  $  NXNK  < 1 »  KB ) *2  $  NX-2 

I F<MISPDT<l#KB).NE.O. OR. NISPDT { 3#  KB I .NE.O) NXNK<1»KBI«1 
NXNK<2#KB»-NXNK<1,KB) 

IF<MISPOTl 1,KB).NE.0)G0T0  45 
XA<2»KB)-X< 3»KB)  $  RA < 2» 2#KB» - R< 3»3,KB> 

GOTO  45 
C 

35  IF<NISPDT<1#KB).EQ.0<  AND . MI S PDT<3»XBI <EQ.O)GOTO  45 
NXNK  < 1#KB I -2  S  NXNK<2#KB)-1 
45  CONTINUE 
C 

IF(KA.EQ<3)  I TYPE-4 
NXD-5  $  NPD-10  S  NKD-3 

CALL  COLSNUA<XA#RA#ALABEL»LSTX,NXNK»NRSCK»PAR#NP»FMSHCK» I  TYPE, 
AX  C  A#  C  A#  LSTN»NRGD»  ERZ#  VPAR#  E  RP  AP.»  NBAD#  NXD#  NKD#  NPO#  WORK#  NWORK  ) 
IF<NB AD.EQ.Q)  GOTO  50 
C 

PRINT  46#<PAR<J)*J-1#NP) 

46  FORK ATI 1H0» 10  X# 4HPAR- #4<3X#1PE12.5) ) 

PRINT  4  7#  <LSTN<J)#J-1#NRSCK) 

47  FORMAT  < 1H  » 10X, 5HLSTN-,10< 3X# I  7) > 

C 

50  CONTINUE 

C 

DO  65  KB- 1#  NRSCK  $  IFILSTN<KBI<NE<OIGOTO  65 
00  55  KC-1#  3  t  XC<KC»  KB)-XCA<KC»KB) 

55  C  <KC#KB)-CA(KC#KBI 
IF<KA<LE<3IG0T0  65 
IFIMISPOTIltKBI.NE.O) GOTO  65 
XC<2#KBI-X<2,KB»  $  C<2#KB>-0 
XC<3»KB)-XCA<2»KB)  $  C < 3»KB ) -C A< 2, KB) 

65  CONTINUE 
RETURN 
END 
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SUBROUTINE  FMSHCK ( XX# CK,NXNK, K A* PAR » F, F X, FP. F X X, FXP, FPP, N8 I 
MULTIPLE  CONSTRAINT  FOR  SHOCK  FITTING 
ARGUMENTS  ARE  DESCRIBED  IN  COLSMU  MANUAL 

DIMENSION  XX(5, 100),CK(3,100),NXNK( 2, 100),  PAR (10), F(  3), 

A  FX(3»5)»FPt3»10l»FXX(5»5)»FXP(5»10l»FPP(10»10) 

DIMENSION  DFX<5)»DFP(10I»DFXK(5»5),DFXP(5»10)»DFPP(10»10)»DX(5*1) 
COMMON/CMISFM/MISPDTI 3, 50  I , DI S T< 501 ,N0DI ST, SC D 
MISPOT  INDICATES  BY  I  IF  P,D  OR  T  IS  MISSING 

DIST  ARE  DISTANCES  OBSERVED.  IF  NOOIST.NE.O  THEN  OIST  ARE  ERROR  FREE 
SCO  IS  THE  SCALE  USED  FOR  DIST 


DO  5  KC-1,4 


00  4  KC-1,4 


FXIK6,KCI«0 


FXX (KB, KC ) *0  J  FXP(KB,KC)-0 


NB«0 

004  KB*1»2  *  F ( KB ) *0  %  00  4  KC-1,4  %  FXIK6,KCI«0 

FP(KB,KC)-0 

00  5  KB-1,4  *  DO  5  KC-1,4  *  FXX(KB,KC>«0  J  FXP(KB,KC>-0 

F  PP( KB, KC I “0 

IF(MISP0T<2,KAI .NE.O)  GOTO  6 
BRANCH  TO  ERROR  RETURN  IF  DISTANCE  IS  MISSING 

% 

DX(1,1)*XX(1,KA)  i  DX ( 2, I ) *  XX ( 2, K A)  %  D X ( 3, 1 ) « X X I  3, K A )  %  M-3 
I F CNODI ST.NE .0)  GOTO  7 

I F (M I  SPOT (l»KA).EQ.O)  GOTO  10  t  I  F( MI  SPOT ( 3, K A  I . EQ. 0 )  GOTO  8 
NB  ■ 99  $  RETURN 

DX(2,1I-DIST(KA)  t  M»1  %  I F ( MI  SPOT ( 1, K A  I . EQ. 0 )  GOTO  9 

0X13, 1>-XXC1,KA)  *  J«1  S  GOTO  60 


0X(3,1)-XX(2,KA) 

ENTER  9  AND  COMPUTE  FIRST  COMPONENT  OF  CONSTRAINT  FUNCTION 
CALL  SH0CK3(0X,  1, PAR, FI  1 ) , DF X,DFP, DF XX,DFXP» DFPP,NB AD ) 
IF(N9 AD.EQ. 0)  GOTO  15  t  NB-NBADMOO  *  RETURN 
15  00  45  KB-1,M  $  F X ( 1,KB ) -OFX ( KB )  *  DO  25  KC-1,M 
25  FXX(KB,KCI-CKU»KA)*DFXXtKB,KC ) 

DO  35  KC-1,4 

35  FXP<KB,KC)*CK<1,KA)*0FXP(KB,KC  ) 

45  CONTINUE 

DO  55  KB- 1, 4  %  FP(1,KBI-DFP(KB»  S  DO  55  KC-1,4 
55  FPP(KB,KC)-CK(1,KA)*0FPP(KB,KC) 


IF(NXNK(2,KA).LT. 2)  RETURN  $  J-2 

>  CALL  F2SHCK ( OX,  1, PAR ,F( J I , DFX , DF P, DF XX, OF XP,  OF PP,NB AO ) 

THIS  IS  THE  SECOND  CONSTRAINT  COMPONENT.  ENTER  60  FROM  8  IF 
ONLY  THE  SECOND  CONSTRAINT  COMPONENT  IS  USED. 

IF(NBAD.EO.O)  GOTO  65  $  NB-NBAD+200  $  RETURN 
\  L-NXNK ( 1, KA  I 

DO  95  KB-1,L  *  KJ-KB»(2-JIM4-2*KB> 

IF(J*M«EQ.2. AND. KB .EQ.2IKJ-3  *  FX ( J ,K 8 ) -OFX ( K J  I 
0075  KC -1, L  $  KK-KC*(2-JIM4-2*KC>  S  IF ( J*M. EQ . 2 . AND. KC . EQ . 2  IKK- 3 
75  FXX(KB,KCI-FXX(KB,KC)+CK(J,KAI*DFXXIKJ,KKI 
00  85  KC-1,4 

85  FXPCK8,KCI-FXP<KB,KCi  ♦CKU»KAI*DFXP<KJ,KC> 

95  CONTINUE 

DO  105  KB-1,4  %  FP(J»KB)-OFP(KBI  S  DO  105  KC-1,4 
105  FPP(KB,KCI«FPP(KB,KCI  ♦CKU,KA)  ♦DFPP  (KB,  KC  I 


SUBROUTING  SHOCK 3 (XX, KA»PAR»F» FX,FP,F XX»FXP,f PP,NBAD) 

C  SHOCK  FITTING  CONSTRAINT  WITH  3  PARAMETERS 

C  THIS  IS  USEO  BY  FHSHCK  AS  THE  FIRST  CONSTRAINT  COMPONENT 

C 

DIMENSION  XX(5,100)»PAR(10)»FX(5)»FP<10>,FXX(5,5),FXPC5»10) 
1FPPC  10,10) 

C 

NBAD-0  S  X»  XX (2, K A  ) 

F  X  ( 1  )  «X*X*X 

F-((  XXC 1,KA)*X-PAR(1) >*X-PAR ( 2 ))*X-PAR( 3 ) 
FX(2)»(3.*XX(1,KA)*X-2.*PAR(1) )*X-PAR(2) 

F X (3  > »0 

FP(1)»-X*X  S  FP<2)«- X  $  FP(3)«-1.  *  FP(A)»0 

F  X  X( 1 , 1 )*  0.  t  FXX(1,2)«3.*X*X  $  FXX (2, 1 ) »FXX( 1, 2 ) 

FXX(2,2)«6.*XX(1,KA)*X-2.*PARC1) 

DO  15  KB= 1 » 3  $  FXX(3,KB)-0.  i  FXX(KB,3)*0  t  DO  15  KC*1,A 
15  F  XP( K8»  KC ) “0 

DO  25  KB»1,A  t  DO  25  KC»1,4 
25  FPP(KB,KC) *0 

FXP(2,1)=-2.*X  S  FXP(2,2)»-1. 

RETURN 


SUBROUTINE  F2SHCK  (  XX,  KA,P  AR  ,  F,  FX»  FP  *FXX,  FXP,  FPP,  NB  AO ) 

C  THIS  IS  SECONO  CONSTRAINT  COMPONENT  FOR  SHOCK  FITTING, 

C  CALLED  FROM  FMSHCK. 

C 

DIMENSION  XX(5,100»,PAR(10)  ,FX<5»  ,F  PUO )  ,FXX  (  5 , 5  >  ,F  XP  (  5,  10  > , 
A  FPPU0,10>,SFI9) 

EXTERNAL  F 2DER 

C  0MM0N/CF2DER/GAMC AP» SN0SPD,CPAR(4|,AL0W»SCD,SCP»SCT 
C  GAMC  AP- 1 C I .♦G AM ) /( 2 .*GAM ) 1*1  SC  PR  / AMBPRI 
C  GAMCAP,  SNDSPD  AND  ALOW  ARE  SET  BY  SUBROUTINE  SCALSH 
C 

DO  15  KB»1,4 
15  CPAR(KB)-PARIKB) 

C  THE  PARAMETERS  CPAR  WILL  BE  USED  BY  SUBROUTINE  F2DER 
X*=XX  <  2,KA) 

DO  25  K8-l,3  %  00  25  KC-1,3 
25  FXXtKB,KCI-0 

IFtX.GT.l. E-30)  GOTO  35  $  NBAO-1  S  RETURN 
35  NBAD-0 

S  Q-l • *G AMC  AP* (I  PAR ( 3) / X*P AR ( 2 I) /X*P AR 1 1 ) ) / X 
IFIS3.GT.1.E-50)  GOTO  45  %  NBAO-2  S  RETURN 
45  FX11)»0.  S  FX ( 2 ) ■  1.  /SQRTISQ)  S  FXI3I— SNDSPD 

FXXt 2,2>-0.5*GAMCAP*FX(2)*l I  3. *PARt 3> SX*2.*PAR I  2 t > / X 
A+PARU) )MX*X*SQ> 

CALL  ROMULT ( F2DER, ALOW, X,SF,NBAD) 

IF(NBAD.EQ.O)  GOTO  55  S  NBAD-NBAD*10  $  RETURN 
55  F-SFI11*IPARI4)-XXI3.KAI )*SNOSPD 

FP11)«SF12I  %  FP(2>»SF(3)  $  FPIJ|-SF<4)  *  FPI4>-SNDSP0 

FPPC 1,1»-SF(51  $  FPPC 1,2)«SF (6)  $  F PR  1 1, 3} -SF { 7  I 
F  PPl 2»1)-SFI6)  S  FPP( 2,21 -SF ( 7  )  S  FPPI2, 3) -SFI 8) 

FPP( 3,1 )-SF 17)  t  FPP( 3*2 1 -SFI  8  I  S  FPPt 3, 3 » «SF ( 9 ) 

DO  65  KB-1,4  t  FPPI4,KB)«0  $  FPPlKB*4l-0  $  FXP(l*KB)-0 
65  FXPI 3, KB) *0 

FXPI2.1J— 0.5*GAMCAP*FXI2im*SQ) 

FXP(2,2>«FXP(2,1»/X  $  FXPI 2, 3 ) -FXPI 2* 2) /X  %  FXPI2,4l-0 
RETURN 


SUBROUTINE  F20ER I X, F, NBAD) 

C  INTEGRAND  FOR  NINE  CONPQNENTS  OF  F2  AND  DERIVATIVES 
OINENSION  F (9 ) 

CONNON/Cf 2DER/GANC AP» SNDSPD,  PARI  A) » ALOW»SCD» SCP.SCT 
C  GAMCAP-I Il.+GAH)/I2.*GAM) )*ISCP  / AMBPR ) 

C  GANG AP»  SNDS PD»  ALOW  AND  SCALES  ARE  SET  BY  SUBROUTINE  SCALSH 
N B AD* 0  $  IFIX.GT .l.E-30)  GOTO  15  S  NBAD-1  $  RETURN 
15  Y-l./X 

SQ-1.«-GAMCAP*(IPAR<3)*Y*PARI2I )*Y«-P ARID )*Y 
IFISQ.GT. 1.E-5C)  GOTO  25  S  NBAD-2  %  RETURN 
C  INTEGRANOS  CORRESPOND  TO  FOLLOWING  QUANTITIES 
C  F,  FP(l)  , I  2),  I  3),FPPI1,1) *11, 2), 1 1,3)- 1  2,2), 12,3), ( 3,3) 

25  F(l)-1. /SQRT(SQ) 

F 1 2) 0.5*G ANCAP*F ll)*Y/SQ 
F I  3) -FI  2) *Y  *  FI4)-FI 3)*Y 
FI5)«— 1. 5*G ANC AP*F 13) /SQ 

F I  6) -FI  5)* Y  S  F I  7) -F I  6  )*Y  S  FI8)-FI7)*Y  $  FI9)-FI8)*Y 
RETURN 


SUBROUTINE  ROMULT C F, A, 8, SF, NB AD ) 

C  ROMBERG  INTEGRATION  OF  A  9-DIMENSIONAL  VECTOR  FUNCTION 
C 

DIMENSION  SF(9)»T(9»10»20>*FA(9I»FB(9)»FN<9)»FM( 9)rC0RKM(9* 10) 
C 

N  B  AD  *  0 

CALL  F( AjFA.NBAD)  $  I F < NB AO . NE . 0 )  RETURN 
CALL  F<  B>  FB.NBAD)  $  I F( NBAD.NE .0)  RETURN 
DO  14  KQ*1,9 

14  T(KD,l,l)»(FA<KD)*FB(KDn*0.5 
KM«1  $  KM  A* 1 

15  DO  16  KD«1»9 

16  FM(K  0 ) *0 
DEN»FL0AT(KMA)*2. 

00  25  KA*1»KMA 

AC*F LQ AT( 1*2* (KM A-KA I l/DEN  $  BC-FLOAT ( 2*KA-1> /OEN 
ARG*AC*A+BC*B 

CALL  F( ARG»FN>NBAD)  *  IF ( NB AD. NE . 0)  RETURN 
DO  23  K0*1»  9 
23  FM(KD J»FM(KDI*FN(KO> 

25  CONTINUE 

DO  26  KD*1»  9  $  FM(K0)»FM(KD1/FL0AT(KMA> 

26  T(KD»1,KM*1»*(T(K0.1»KH)*FM(KD>>*0.5 
C 

C  THIS  IS  TRAPEZ.  NEXT  COMPUTE  ROMBERG 
KM=KM>1  S  KC-1  t  D0EN*1. 

35  f(C*KC  *1  *  DDEN«DDEN*4. 

DO  37  L*l»  9 

CORKM(L»KC)*(T(L#KC— 1»KHI— T(L»KC— 1»  KM— 1 ))/(DDEN— 1.) 

37  T(L»KC»KM)*T(L»KC-1»KM)*C0RKM(L»KC) 

IF(KC.LT.KM.AN0.KC.LT.10I  GOTO  35 
C 

C  NEXT  TEST  CONVERGENCE 

IF(KM.GE.3>  GOTO  45  $  KMA»KMA*2  *  GOTO  15 
45  IF(KM.GE.20J  GOTO  56 
DO  53  L»l,9 
TEST»ABS(CORKM(L,KC)> 

C  KC*MIN( KM» 101 

IF(TEST.LE.1.E-100>  GOTO  53 
IF(TEST.LE.ABS(T ( L»KC  »  KM ) }* 1 .E-10)  GOTO  53 
KMA*KMA*2  S  GOTO  15 
53  CONTINUE 
C 

56  DO  58  L«l#9 
58  SF(LI«T(L»KC»KMJ*(B-A) 

RETURN 

END 


SUBROUTINE  PRSH AO ( SCO  IS  * S CP  RE , SCT IM,KK, XC, C , R , LSTN, AL AB, 

A  NRSHOK, TITLE) 

THIS  PRINTS  AO JUSTE  0  SHOCK  DATA 

ROUTINE  SHOULD  BE  CALLED  AFTER  RETURN  FROM  FITSH 

DIMENSION  XC!5,50),R! 5,5, 50),C!5,50),  ALABI2.50) 

DIMENSION  TITLE! 3)»LS  TNI  501 

COMMON/CMISFM/MISPDTI 3, 50 > , DI S TNI  50 >, NOD  IS T , SC DD 

T8=IH 

P8»1H 

K*0 

DO  100  1= 1,NRSH0K 

I  F ILS  TN  1 1 ) . NE .0 )  GO  TO  100 

K«K*1 

IF(M0D(K»40).NE.l)  GOTO  18 
PRINT  2, TITLE 
2  FORMAT! 1H1 , 45X, 3 A10 ) 

PRINT  5 

5  FORMAT  1 1H  , 45X, * ADJUS  TED  SHOCK  OBSERVATIONS*,//) 

PRINT  10 

10  F0RMATI1H  , AH  NR . , 8X, 6HLA BEL S , 12X, 6HT IME  ♦» 25X, 12H0VERPRESSURE, 

A  23X, 10H0ISTANCE  ♦,/, 

B1H  ,  28X,10HC0RRECTI0N,2X,8HC0RRECT.,2X, 9HST  D. ERROR, 2X, 
C11H+C0RRECTI0N, 2X,8HC0RRECT.,2X,9HSTD.ERRQR,3X, 
OlOHCORRECTI0N,2X,8HCQRRECT.,2X,9HSTD.ERROR,  /) 

IFISCTIM. EQ.1.1PRINT  11 

11  FORMAT  1 1H*,31X, 3HIS),  2I8X,3HIS ) ) ) 

IFISCTIM. NE.1.)PRINT  1101 

1101  FORNATl 1H*,29X,8HI SCTIME) »1X»2I2X»8HISC TIME)) > 

IFISCPRE. EO.l.) PRINT  12 

12  FQRMATI1H*»64K»4HIPA)»2I?X»4HIPA))) 

IFISCPRE. NE.1.)PRINT  1201 

1201  FORMAT! 1H*, 63X, 8HI SCP RES ),2I 3X , 8HI SCPRES  ) )  ) 

IFISCDIS.EQ.1.)PRINT  13 

13  FORMAT! 1H*,99X»3H(M),  2I8X,3H!M) ) ) 

IF(SCDIS.NE.1.)PRINT  1301 

1301  FORMAT!  1H ♦ , 97X, 8H I  SCO  I  ST ) , 1 X, 2  1 2X, 8H l SC DIST ) ) ) 

PRINT  15 
15  FORMAT I 1H  ) 

18  CONTINUE 

IFIKK.EQ.l)  GO  TO  30 
IF  IKK. E  0. 2 )  GO  TO  40 
IFIKK.EQ.3I  GO  TO  50 
IF  IKK. EQ. 4)  GO  TO  60 

30  R 1*S  QRT IR ! 1 ,1, 1 ) ) 

C I  2,  I ) *0. 0 

R  2  =  0 . 0 

PRINT  21,1,  ALAB!  1,1),  AL AB ! 2, I ) , TB, T B, TB, XC 1 1, I ) , C 1 1, I ) , R 1, XC ( 2,  I ) 
1  C ! 2,  I),R2 

21  F0RMATI1H  ,I4,1X,2A10,3X,A10,1X,A9, 1X,A10,2I3X,1PE10.3,1X, 

A  1PE9.2,1X»1PE10.3) ) 

GO  TO  90 

40  R1«SQRTIR!1,1,D) 

R2*SQRTIR!2,2,I)  ) 


PRINT  21,1* ALABt 1,1), ALAB 1 2, I ) , TB,TB» TB, XC 1 1, I) , C 1 1 ,  I ) , Rl , XCt2, I) 
1  Ct2*I),R2 
GO  TO  90 

50  IF(MISPDTtl,I)'EQ.O.O.AND.MISPDTt3,I).EQ.O.O)  GO  TO  51 
IFtMISPOTtl,I).NE.O.O)  GO  TO  52 
IFtMISPDTt3,I).NE.0.0)  GO  TO  53 

51  Rl*SQRTtRll,l»I) ) 

R2«SQRTtRt2,2,I) ) 

R3»S0RTtRt 3,3,1)  ) 

PRINT  20,  I,  ALABt  1,  I ),  ALAB  (  2,  I  )  ,  XC  t  3,1  >, C  ( 3,  I ) ,  R3,  XC  ( 1,  I )  ,  C  1 1,  I  )  , 

1  R1,XC12,I),C12,I)»R2 

20  FORMATtlH  ,  14,1  X,  2  A10  »  3  (  3X,  1PE  10.  3#  IX,  1PE9. 2*  1 X,  1PE  1 0.  3  ») 

GO  TO  90 

52  Rl*$  QRT (R ( 1*1,1 )  ) 

R2-SQRT(R<  2, 2, III 

PRINT  22, I, ALAB < 1,1),  ALAB C2, I» ,XC (1,1 l,C(l, I » , Rl, PB, PB» PB, XC ( 2, I) 
1  C (2, I )  ,R2 

22  FORMAT ( 1H  , 14, IX, 2A10, 3X, 1PE10.3, IX.1PE9.2, IX, 1PE10 . 3, 3X, AlO, 

A  IX,  A9,1X, A10,3X,1PE10.3,1X,1PE9.2»1X,1PE10.3) 

GO  TO  90 

53  R1-S0RT(R( 1,1,1) » 

R2-S0RT(R(2,2,m 

PRINT  21,  I,  ALAB  (1,  I),  AL  AB  <  2, 1 1  ,TB,TB,  TB,  XC  1 1,  I )  ,  C  ( 1,  H,R1,XC<2,  I) 
1  C ( 2, I ) ,R2 
GO  TO  90 

60  IF(MISPDT  <  1,  D.NE.O)  GO  TO  61 
IF(NISPDT(3,I).NE.O)  GO  TO  62 
R2-0.0 

R1«SQRT(R(1,1*I>) 

R3*S0RT(R( 3,3,1)  ) 

PRINT  20, I,ALA8(1,I), ALAB ( 2, 1 ) , XC (3,1 ) ,C 13, I ) ,R3, XC ( 1, I ),C 1 1, 1 ) , 

1  R1,XC(2,1),0. 0,0.0 
GO  TO  90 

61  R1*SQRT(R(1»1»I) ) 

R2«SQRTIR(2,2,I) ) 

PRINT  22, I, ALABt 1,1), AL AB ( 2, I) , XC t 1, I ) ,C t 1, I ) , Rl, PB, PB, PB, XC ( 2 , I ) 
1  0.0, 0.0 
GO  TO  90 

62  Rl*SORT(Rt 1,1,1) ) 

PRINT  21, I, ALABt l, I), ALAB (2, I) , TB,TB, TB, XC ( 1, I ) ,C ( 1, I) ,R1»XC <2,  I ) 
1  0.0, 0.0 

90  IFtMQOtK, 5) . E Q. 0 )  PRINT  15 
100  CONTINUE 
RETURN 
END 


SUBROUTINE  OIMPARS  CKK  ,  SCO IS,  SC PRE»SCTIM, P ARS,  NP,  VPARS* ERZS» 

AP ARS D»VPARSO» TITLE) 

C  THIS  COMPUTES  DIMENSIONAL  VALUES  OF  SHOCK  PARAMETERS 
C 

C  KK  -  MODIFIER  INDICATING  WHAT  HAS  BEEN  ADJUSTED 
C  SCDIS,  SCPRE  »  SCTIM  •  SCALES  OF  PARS  AND  VPARS 
C  PARS ( 10 )  »  SHOCK  FITTING  PARAMETERS 

C  NP  •  NUMBER  OF  SHOCK  FITTING  PARAMETERS 

C  VP ARS!10» 10)  -  VARIANCE  MATRIX  OF  PARAMETERS  PARS 

C  ERZS  -  STANDARD  ERRROR  OF  A  SET  WITH  WEIGHT  ONE 
C  PARSD(IO)  -  SHOCK  FITTING  PARAMETERS  IN  SI  UNITS 
C  VPARSD! 10, 10 )  -  VARIANCE  MATRIX  OF  PARAMETERS  PARSD 

C  TITLEC3)  -  NAME  OF  EVENT 
C 

DIMENSION  PARS!  10), VP ARS! 10, 10 ),PARSO! 10), VPARSD! 10, 10), TITLE! 3) 
DIMENSION  SCMAT!10,10),0IM!10) 

C0MM0N/CF2DER/  GAMCAP,SNDSPO» CPARI 4) »OLIM, SCO, SCP, SCT 
C 

DATA! IDIM! J),J-1,4)-7HPAAM  »7HPA*M**2»?HPA*M*P3»7HS  ) 

C 

PRINT  11, ( TITLE! J ) , J- 1, 3) 

11  FORMAT! 1H1,10X,5HEVENT,5X,3A10,/,1H  ,10X,5(1H-)) 

C 

DO  15  K  A-  L  ,  1 0  S  DO  15  KB-1,10 
15  SCMAT!KA,KB)-0 

SCMATi 1»1)-SCPRE*SC0IS 
SCMAT ! 2,2) -SCPRE *SC0IS**2 
SCMAT 13,3) -SCPRE ASC0IS**3 
SCMAT!4,4)-SCTIM 
C 

DO  45  KA-1,4  %  PARSD! KA)*0 
DO  35  KB-1,4  S  VPARSD !KA, KB ) -0 
00  25  KC- 1,4  *  00  25  KD-1,4 

25  VPARSO!KA,KB)«VPARSOIKA,KB)^SCHAT!KA,KC)*VPARS!KC,KD)*SCNAT!KD,KB) 
35  PARSD !KA) -P ARSO (K A)+SCMAT (K A, KB ) *PARS !KB ) 

45  CONTINUE 
C 

PRINT  55 

55  F ORM AT! 1H0,///,1H  , 10X, 32HDIMENSI0NAL  VALUES  OF  PARAMETERS,/) 

PRINT  65 

65  FORMAT! 1H0, 10X, 10HPAR AMETERS, 5 X,8HS TANDARD, 7X,  8HSTANDARD, 5X , 
A9H0IMENSI0N,/,1H  , 26X,6HE RRORS , 7X, 10HERR0RS*E RZ, / ) 

DO  85  KA-1, NP 

PER-SQRT! VPARSO!KA,KA))  S  PERZ -PERAERZS 
PRINT  75,PARSD!KA),PER,PERZ,DIMIKA) 

75  FORMAT! 1H  , 9X,1PE12. 5 , 3X, 1PE 10. 3, 4X , 1PE 10. 3, 6X, A7) 

85  CONTINUE 

OLIMO-OLI MASCO 
IF!NP.E0.4) PRINT  88,0LIM0 

88  FORM  AT! 1HA, 62X, 2  3H-  SHOCK  ARRIVAL  TIME  AT, 1PE 12. 3,7H  METRES) 

PRINT  95 

95  FORMAT! 1H0,///,1H  ,10X,31HTHE  SHOCK  OVERPRESSURE  FUNCTION, 

A  12H  IS  GIVEN  BT, 

B  / /, 1 H  ,20X, 40HP  *  PAR«1)/R  ♦  PAR!2)/RAA2  ♦  P AR( 3 ) /R AA3, / / ) 

PRINT  135 

135  FORMAT! 1H0,//,1H  , 10X, 37HADJUSTE0  ARE  OBSERVATIONS  OF  PRESSURE) 


60 


IF (KK- EQ. 2  »  PRINT  136 

136  FORM  AT  ( 1H*»47X»13H  AND  OISTANCE) 
IF(KK.EQ. 3)  PRINT  137 

137  F0RMAT{1H*»47X»19H»  DISTANCE  AND  TINE) 
IF(KK.EQ.4)  PRINT  138 

138  F0RMAT<1H*,47X,9H  AND  TINE) 


65 


70 


75 


80 


COMPUTE  CORRELATION  MATRIX 

DO  185  KA  *  1 , NP  *  DO  185  KB*1,NP 
185  SCMATIKA,KB)«VPARS<KA,K9) /S QRT < VP AR S< KA,KA > *VP ARS< KB, KB  I) 
PRINT  195 

195  F0RMAT11H  »///» 1H  , 10 X, 1 8HCQRR E LATI ON  MATRIX,//) 

DO  215  KA* 1 »NP 

PRINT  205, (SC MAT (KA,J )»J*1,NP) 

205  FORM  AT ( 1H  , 10X, 6 ( 0PF1 3 . 8)  ) 

215  CONTINUE 

PRINT  105 

105  FORM AT ( 1H  ,//,lH  , 10X , 27H VAR  I ANC E-C QV AR I ANC E  MATRIX  , 

A3 3H( NOT  INCLUDING  THE  FACTOR  ERZ+*2>,//> 

DO  125  KA*1,NP 

PRINT  115,( VPARSOIKA, J),J*1,NP) 

115  FORM  ATI 1H  , 10X, 6 ( 3 X » 1PE 12 . 5 >) 

125  CONTINUE 
RETURN 
END 


P2 


1 


5 


10 


15 


20 


25 


30 


35 


40 


45 


50 


55 


SUBROUTINE  P« ..POSl.iMv#  SCO  I  >  SC  PR ,  SCT I  »NRSHOK»  P  AR  *  NP,  VP  AR,  E  RZ  , 
AE  RFA  C  T  i 

C  TmS  PLOTS  PRESSURE  OVER  DISTANCE  (DATA  AND  FITTED  CURVE) 

C 

C  KK  =  INDICATES  WHAT  HAS  BEEN  ADJUSTED.  SEE  STAT.  185  FF. 

C  SC  DI  ,  SC  P  R»  SC  T  I  *  SCALES  TO  BE  USED  ON  INPUT  DATA 
C  NRSHOK  »  NUMBER  OF  INPUT  DATA  SETS 
C  PAR  =  PARAMETERS  OF  SHOCK  FITTING  FUNCTION 
C  NP  *  NUMBER  OF  PARAMETERS 

C  VPAR  *  VARIANCE-COVARIANCE  MATRIX  OF  PARAMETERS 
C  ERZ  =  STANDARO  ERROR  OF  SET  WITH  WEIGHT  ONE 
C  ERFACT  *  ERROR  FACTOR  TO  8E  USEO  FOR  CONFIDENCE  CURVES 
C 

C  PROGRAM  CALLS  ROUTINE  SH0CK3  TO  GET  FITTED  CURVE 
C 

DIMENSION  PAfi(10l,VPAR(10»10) 

C 

C0MM0N/C0MSH0T/TPXH(4,50),ERTPXH(4, 50) , TITL E( 3  )  , ALB( 2# 50) 
C0NM0N/ANBCHA/AMB(8) 

C  THIS  CONTAINS  INPUT  DATA 
C 

C0MM0N/PL0T/PD(6).PLABL(4) 

C  FROM  THIS  COMMON  BLOCK  USE  ONLY  THE  PLOTTING  LABEL 
C 

COMMON/CM  I SFM/MI SPOT! 3 , 50 ) , D I S TN ( 50 ) , NOD  IS T , S C DO 

C 

DIMENSION  PMIHA(2)»DNIMA(2(»TMIMA(2), 

AO (5,  1 >,FX!5),FP<10),FXX(5,5),FXP(5, 10),FPP!10,10), 
BTEXT(6),XP(201), YP ( 20 1 ) , YPE ( 2 0 1 ) , ERYP ( 2 01 ) 

C 

DATA<  ANAME=6HPLP0SH) 

CALL  LQGSC(SCDI»SCPR,  SC TI , ANAME, Dhl MA, PHI MA, TMIMA, SCL, NBD ) 
IF(NBD.NE.OIRETURN 

C  THIS  ESTABLISHED  LOGARITHMIC  PLOTTING  SCALES 
C 

CALL  PLTBEGI21. 0,28. 0,0. 3973,1 3, PLABL) 

XSC=SCL  l  X  OR-OM I M A ( 1  )  $  XR AN- DMIMA 1 2 )-DMI MA ( 1 ) 

YSC-SCL  S  YOP-PMIMA(l)  $  YR AN » PM  IMA ( 2 ) -PM  I M A( 1 ) 

CALL  PLTSC A(5.0»9.0,X0R, YOR,  XSC» YSC ) 

0 X «1  .  t  XLEFT-XOR  $  X R IGHT» XOR ♦ AMAX 1! XR AN, A INT ( 1 0.* X SC  )  ) 
0Y«1.  $  YBOT-YOR  $  YT OP-Y OR* AN AX1 ( YRAN, A INT ( 1 0 .* YSC ) ) 

NTYP  E*7 

CALL  PLTAXS(DX»DY,XLE F T, X R IGH T, YBOT , YTOP, NT YPE ) 

CALL  LABLQG<  DX, D Y , X LE F T, X R I6HT , YB OT , Y TOP, 0. 0, 0 . 0 ) 

25  FORMAT ( 3A10, 1H>( 

ENC00E(31,25,TEXT(1)) ( TITLE (J) ,J«1,3> 

CALL  PLTSYM(0.4,TEXT( 11,0.0, X L EFT , Y BOT- YSC *  4. 0 ) 

35  FORMAT! I3HDISTANCE  <M>>> 

ENCODE ( 13, 35, TEXT! 1 ) ) 

TX=( X  LEFT* XRIGHT) *0.5-6. 0*0.3* XSC 
TY=YB0T-1.5*YSC 

CALL  PLTSYM(0.3»TEXT( 1),0.0,TX,TY) 

36  FORMAT! 18H0VERPRESSURE  (PA)>) 

ENCODE! 18 , 36, TE  X  T ( 1 ) ) 

T  X  =  XLEFT-I.8*XSC 

TY-! YB0T*YT0P)*0.5-B.0*0.3*YSC 

CALL  PLTSYM(0.3,TEXT( 1 ) , 90. 0, T X, TY ) 


b'\ 


00  45  KA*l.NRSHOK 
IF(MISP0T(2,KA).NE.0)  GO  TO  45 
IF(MISPDT(1»KA).N£.0)G0T0  45 

XP(1»  «0.5*ALOG10( <TPXH<3,KAi**2*(TPXHC4*KA)-AHBm)**2>/SCDI**2 > 
C  AM B( 7 >  *  CHARGE  ELEVATION  (IN  C OMHON/ ANBCHA/  ) 

YPU  >*AL0G1C(TPXH(2,KA)/SCPR) 

NS-MISPDH  3.KAI  t  CALL  PLTOTS(3*NS»XP»YP*1»OI 
45  CONTINUE 

C  THIS  PLOTTED  OATA  POINTS 
C 

C  NEXT  PLOT  FITTED  CURVE 

CALL  PLTWND(XLEFT»XRIGHT»YBOT»YTOP) 

IP*1 

00  65  KA* 1»  201 

XP<IP)-XLEFT*(XRIGHT-XLEFT!*FL0AT(KA-l>/200. 

Q(1»1I»0  *  a<2»l)«10.**XP (IP)*SCOI 

c 

CALL  SH0CK3{Q»1»PAR»F*FX»FP»FXX»FXP»FPP*NBAD) 

C  THIS  CALL  TO  THE  CONSTRAINT  FUNCTION  FURNISHES  FITTEO  CURVE 
C 

IF(F.GE.O..OR.NBAD.NE.O)GOTO  65 
YP(IP) *AL0G10<-f /(0<2»ll**3*SCPR)> 

F  Y*0 

00  55  KB-l.NP  S  00  55  KC-l.NP 
55  FY-FY4FP(KBI*VPAR(KB, KC  J*FP(KC) 

ERYP( IP)»S0RT(FY)/(ALQG(10. !  *1  — F  )  ) 

C  LOGARITHMIC  ERROR  IS  INDEPENDENT  OF  SCALE 
IP-IP4I 
65  CONTINUE 

I  PM* I  P—1  $  IFCIPM.LE. OIGOTO  120 
DO  105  KE*1*2 

DO  95  KB-1»3  S  ERF-ERFACT*FL0ATIKB-2» 

IF(KE.EQ.1)G0T0  75  $  IF ( ERZ . LT . 1 . 5) GOTO  105  $  ERF«ERF*ERZ 
75  DO  85  KP* 1» IPM 
85  YPE(KP)-YP(KP>*ERF*ERVP(KP> 

CALL  PLTDTS(1,0,XP,YPE,IPM,0I 
95  CONTINUE 
105  CONTINUE 

115  F0RMAT(21HC0NFIDENCE  LIMITS  F0R.F4. 1* 17H  STANDARD  ERRORS> ) 

120  ENC00E(42»115»TEXT(1) )  ERF  ACT 

CALL  PLTSYM(.25»TEXT< 1)»0.0, XLEFT>YB0T-YSC*5.0! 

IFCERZ.GE .1.5) GOTO  145 

125  FORMAT!  24H WITHOUT  THE  FACTOR  ERZ  «»F6.3*1HM 
ENCODE ( 31 »125»TEXT( 1»» ERZ 
GOTO  155 

135  FORMAT ( 33HWITH  AND  WITHOUT  THE  FACTOR  ERZ  »#F6.3,1H>) 

145  ENC0DE(40»135»TEXT(1) IERZ 

155  CALL  PLTSYM(.25,TEXT( Ilf 0 .0, XL EFT> YB0T-YSC*5.4 ! 

IFIKK.NE.U  GOTO  175 

165  F0RMAT(38HADJUSTE0  ARE  OBSERVATIONS  OF  PRESSURE*! 

ENCOOEC 38,165,TEXT<1> ) 

CALL  PLTSYM(.25»TEXT< 1 ) » 0 .0* XLEFT* YBOT-YSC  *5.8) 

GOTO  265 

175  ENC0DE(29»185»TEXT(1) ) 


FORMAT! 29 HADJ US TED  ARE  OBSERVATIONS  OF*) 

CALL  PLTSYM1.25* TEXT! 1)»0.0» XLEFT>YBOT-YSC  *5.8) 

IF(KK.EQ.2>  60  TO  195 

IF(KK.EQ.3>  GOTO  215 

IF!KK.E0.4)  GOTO  235 

GOTO  265 

ENCODE! 22»205»TEXT(1I )  *  GOTO  255 

FORMAT! 22HPRESSURE  AND  DISTANCE*! 

ENCODE! 26» 225/TE XT! 1 I )  *  GOTO  255 

FORMAT! 23 HPRESSURE*  DISTANCE  AND  TIME*) 

ENCODE !18*245#TEXT!1) >  %  GOTO  255 

FORMAT! 18HPRESSURE  AND  TIME*) 

CALL  PLTSYM!.25»TEXT!1)»0.0»XL EFT» YBOT-YSC  *6.2) 

CONTINUE 

CALL  PLTPGE 

RETURN 

END 


l 


SUBROUTINE  PLPTSHIKK#  SCO  I  ST , SC  PRES, SCTIME, NRSHOK, PAR4, NP» V4 , 

1  ERZ4, ERFAC  > 

C  THIS  PLOTS  PRESSURE  OVER  TINE  (DATA  AND  FITTED  CURVE) 

C 

C  KK  INOICATES  WHAT  HAS  BEEN  ADJUSTED 

C  SCOIST»SCPR£S»SCTIME  *  SCALES  TO  BE  USED  ON  INPUT  DATA 
C  NRSHOK  »  NUMBER  OF  SHOCK  OBSERVATION  STATIONS 
C  PAR4I 10 )  *  SHOCK  PARAMETERS 

C  NP  »  NUMBER  OF  SHOCK  PARAMETERS 

C  V4 I 10, 1 0 )  *  VARIANCE  MATRIX  OF  SHOCK  PARANERERS  PARA 

C  ERZ4  *  STANOARO  ERROR  OF  A  SET  WITH  WEIGHT  ONE 
C  ERFAC  «  FACTOR  FOR  CONFIDENCE  LIMIT  PLOTTING 
C 

C  ROUTINE  USES  SH0CK3  AND  F2SHCK  FOR  THE  COMPUTATION  OF  FITTED  PRESSURE 
C 

DIMENSION  PAR4I10)»V4I10»10)»TEXTI6)  CURVE 

C 

DIMENSION  PMIMAI2),0MIMA12),TMIMAI2> 

DIMENSION  XPI201)»YP1201)»£YPI201)»YPE1201)»QI5>1) 

DIMENSION  FXt5>,FPllO),FXX(5»5l»FXPl5,10>»FPPU0f  10) 

C 

C0Mi10N/CJMSHDT/TPXHl4»50)»ERTPXHI4» 50) » TITLE (3), ALABI2,50) 
COMMON/AMBCHA/AMPR, AM T EM, GAMMA, AMMOL, CH VOL, CHEN, HC,ERCHEL 
CC  THESE  TWO  COMMON  BLOCKS  CONTAIN  INPUT  DATA 
C 

C0MM0N/PL0T/PD16), PLABLI4  > 

C  FROM  THIS  COMMON  BLOCK  USE  ONLY  THE  PLOTTING  LABEL 
C 

C0MM0N/CF20ER/GAMCAP,SNDSPD*CPAR14),AL0W,SCD.SCP»SCT 
C  THIS  COMMON  BLOCK  IS  NEEOED  BY  THE  CONSTRAINT  ROUTINES 
C 

COMM  ON/CM ISFM/MISPDTI 3,50 >, CIS  TNI 50), NODIST,SCDD 
C  MISPOT  IS  USED  TO  IDENTIFY  MISSING  DATA 
C 

DATA!  ANAME-6HPLPTSH) 

IFIXK.LE.2)  RETURN 

C  PLOT  OVER  TIME  ONLY  IF  TIME  IS  AN  OBSERVABLE 
C 

SNOSPD*SNDSPD*SCO*SCTIME/(SCT*SCDIST) 

ALOW-ALOW+SCD/SCDIST 

GANC AP«GAMC AP*SC PRE ST SCP 

SCD*SCDIST 

SCT*SCTIME 

SCP*SCPRcS 

C  THIS  WILL  CAUSE  F20ER  TO  PRODUCE  RESULTS  IN  THE  PROPER  SCALES 
C 

CALL  LOGSCISCDIST»SCPRES»SCTIME»ANAME»DMIMA»PMIMA,TMIMA»SCL»NBD) 
IF(NBD.NE.O)  RETURN 

C  LOGSC  COMPUTED  PROPER  PLOTTING  SCALES 
C 

CALL  PL TB EG  1 2 1.0, 28. 0,0. 394, 1 3, PL ABL) 

XSC*SCL  %  XOR  *TM  IM  A  ( 1  )  J  XR AN= TMI MA 1 2 )-TMIM At  1 ) 

YSC-SCL  5  Y0P*PMIMAI1J  t  YR AN* PMIMA 1 2 )-PM I  MAI  1 ) 

DX*i.  t  XLEFT «XOR  $  XRIGHT=XLEFT*AMAX1I XRAN, AINTl 10.*XSC> ) 

D  Y*1  .  t  Y  BOT  *  YOR  \  YT CP«Y BOT* AMA XI l YR AN, A  INTI  10. *YSC ) ) 

CALL  PLTSCA(5.0»9.0»XOR»YOR»XSC»YSC) 


W'T 


60 


65 
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75 
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05 


90 


95 


100 


105 


110 


Wm  V  l' 


NTY°£  *7 

CALL  PLTAXS(OX,OY,XLEFT,XRIGHT,YBOT»YTOP»NTYPEI 
OXL*1.0  $  0YL-1.0 

CALL  LABL0G(0XL,0YL» XLEFT, XR IGHT, YBOT, YTOP, 0. 0, 0.0) 
TEX*10HTIME  (S)>  *  E NCODE < 10, 179,TEXTC1> > TEX 

179  FORM  AT ( A10 ) 

T  X*  (  XLEFT ♦XRIGHT) *0.5-4.0*0.3*YSC 
TY**B0T-l. 5*YSC 

CALL  PLTSYM<0.3, TEXTC1 1,0.0, TX,TY» 

301  F0RMAT<i8H0VERPRESSURE  CPA)>) 

ENCODE! 13, 301, TEXT(l)  ) 

TX*XLEFT-XSC*1.7 

TY*( YBOT* YTOP >*0.5-8. 0*0.3* YSC 

CALL  PLTSYM! 0.3,  TEXT! 1), 90. 0, TX,TY ) 

ENCODE! 31, 178, TEXT (1 » M TITLE (J ) ,J-1»3) 

CALL  PLTSYM! 0.4, TEXT! 1 >,0.0, XLEFT»YB0T-YSC*4.0> 

N  PP*  0  *  00  197  KP* 1, NRSHQK 

IF!MISPDr!l,KP).NE.0.0R.MISPDT(3,KP>.NE.0>  GOTO  197 
N  PP*  N  PP  *1 

XP(NPP)*AL0G10!TPXH!l,KP> /SC  TIME > 

YP!NPP>»AL0G10( TPXH(2»KP)/SCPRESl 
197  CONTINUE 

CALL  PLTDTS(3,0,XP»YP,NPP,0> 

C  THIS  PLOTTEO  DATA 
C 

C  NEXT  FIND  SUCH  DISTANCE  LIMITS  THAT  CORRESPOND  TO  P,T-WINDOW 
DPLRAN*0MIMA(2>— DMIMA(1> 

OISTMI*DMIMA( 1) 

DISTMA*DISTMI*AMAX1(DPLRAN,  AINT(  10.  *SCL  ) > 

DELO  X  * ( OIS  TMA-D ISTMI>/20. 

Q !  1,  1 )  *0.  $  Q(3,l»*0 

LOW*  0 

DX*DISTMI 

405  0(2* 11*10. **DX*SCDIST 

CALL  SH0CK3(Q,1,PAR4,F,FX,FP,FXX,FXP,FPP,NBAD> 

C  THIS  ROUTINE  COMPUTES  THE  NEGATIVE  OVERPRESSURE 
0VP*-F/IQ!2»1>**3*SCPRES> 

IF(OVP.LE.Oa)  GOTO  425 

IF(N8AD.NE.0.0R.AL0G10(0VP).GT.YT0P)  GOTO  415 
C  BRANCH  IF  PRESSURE  IS  OUTSIDE  WINDOW 

CALL  F2SHCK(0,1,PAR4, F,FX, FP, F XX, FXP, FPP,NB AD  I 
C  THIS  ROUTINE  COMPUTES  TIME 
T IM*  F  X (  SNOSPO*SCTIME) 

IFCTIM.LE.O.I  GOTO  425 

IF(NBAD.NE.O.OR.ALOGIOITIM) .LT.XLEFTI  GOTO  415 
C  BRANCH  IF  TIME  IS  OUTSIDE  WINDOW 
L  OW*  1 

C  AN  INSIDE  POINT  FOUND.  GET  A  LOWER  LIMIT  OUTSIDE  POINT 
DX*DX-DELDX 
GOTO  405 

415  IF(L0W.EQ.1)G0T0  425 
D  X*U  X  *DEL  D  X 
GOTO  405 

C  NEXT  SEARCH  FOR  UPPER  LIMIT 
425  DISTMI*OX 
L  AR*  0 
DX-DISTMA 


87 


«  < 


435  QI2»1)*10.**DX*SCDIST 

CALL  F2SHC  K(Q>1»  PAR4*  F»FX»FP»FXX»FXP»FPP#NBAO) 
TIM*F/<SNDSPD*SCTIME) 

IF(TIM.LE.O. )  GOTO  455 

IFINBAD.NE.O.OR. ALOGIO(TIM) .GT.XRIGHT)  GOTO  445 
C  BRANCH  IF  TIME  OUTSIDE  WINOOW 

CALL  SH0CK3(Q,1,PAR4, F,FXtFP,FXX,FXP»FPP»NBAD) 
OVP*-F/(Q<2*l)**3*SCPRES> 

IFtOVP.LE.O.)  GOTO  455 

IF(NBAD.NE.0.0R.AL0G10(QVP).LT.YB0T)  GOTO  445 
C  BRANCH  IF  PRESSURE  OUTSIDE  WINDOW 
OX*DX+DELOX 
LAR*1 

C  AN  INSIDE  POINT  HAS  BEEN  FOUND.  GET  AN  OUTSIDE  POINT 
GOTO  435 

445  IF(LAR.E0.1)G0T0  455 
OX*DX— DELOX 
GOTO  435 
455  DISTMA-DX 

C  NEXT  COMPUTE  FITTED  CURVE  FOR  PLOTTING 
IP«1 

DO  201  KP*1»201 

PXP*DISTMIMDISTMA-DISTMI)»FL0ATCKP-l)/200. 

Q  ( 1»  1 )  *0.$  QC2»1)*10.**PXP*$CDISTS  0(3,1)*0 

C 

CALL  SH0CK3<Q»l»PAR4f F,FX»FP,FXX» FXP» FPP.NBAO) 

C  FIRST  SHOCK  FITTING  CONSTRAINT  ROUTINE  PROVIDES  PRESSURE 
IF(F.GE.O..OR.NBAD.NE.OI  GOTO  201 
C 

YP( I P ) *AL0G10(— F / <  Q  C 2» 1)**3*SCPRES) ) 

EY*0.  *  DO  199  KB*1*NP  %  DO  199  KC«1»NP 
199  EY»EY*FPCKB)*V4(KB»KC l*FP(KC» 

E  YP( IP)-SQRT(EY)/(ALOGUO.)*i  ~F)) 

C 

CALL  F2SHCK(0»1»  PAR4»  F»FX*FP>FXX»FXP»FPP»NBAD) 

C  SECOND  SHOCK  FITTING  CONSTRAINT  ROUTINE  PROVIDES  TINE 
IF(F.LE.O..OR.NBAO.NE.O)  GOTO  201 
C 

XP(IP)*ALOG10(F/(SNOSPO*SCTINE)) 

IP«IP*1 

201  CONTINUE 

C  NEXT  PLOT  FITTED  CURVE 

CALL  PLTWNO ( XLEFT»  XRIGHT»  YBOT»  YTOP) 

00  2031  KE*1,2 

KPM-IP-1  %  IF  € KPM.LE.O)  GOTO  2031 
DO  203  KB*  1»  3  $  ERF-ERFAC*FL0AT(KB-2) 

IF(KE.NE<2) GOTO  2011  S  IFIERZ4.LT. 1.5) GO TO  203  $  ERf*ERF*ERZ4 
2011  CONTINUE 

DO  202  KP*1,KPM 
YPE(KP)*YP(KP)*EYP(KP  )*ERF 

202  CONTINUE 

CALL  PLTDTS(1»0»XP»YPE»KPH»0) 

203  CONTINUE 
2031  CONTINUE 


ENCODE <60, 5, TEXT <1)»ERFAC 

5  FORMAT <  PCQNFIOENCE  LIMITS  FOR  *»F*.l,*  STANOARO  ERRORS>*» 
CALL  PLTSYM!.25,TEXTI1»,0.0,XLEFT,YBOT-YSC*5.0> 

I F (E R Z 4 . GE . 1 . 5)  GO  TO  14 
ENC0DE(31,10,TEXT<1)>  ERZ4 
10  FORMAT  <  *WI THOUT  THE  FACTOR  ERZ  -*,F6.3,1H>) 

GO  TO  16 

14  ENCOOE  (40»15»TEXT<in  ERZ4 

15  FORMAT <  *HI TH  AND  WITHOUT  THE  FACTOR  ERZ  »*,F6.3,1H>) 

16  CALL  PLTSYM!.25,TEXTm»0.0,XLEFT,YB0T-YSC*5.4> 
IF(KK.NE.l)  GO  TO  24 

ENCODE ( 38  »  20, TE  XT! 1 ) ) 

20  FORMAT < *A0 JUSTED  ARE  OBSERVATIONS  OF  PRESSURE>*» 

CALL  PLTSYH!.25,TEXT!1>,0.0,XLEFT,YBOT-VSC*5.8) 

GO  TO  265 

24  ENCODE! 29 ,25, TEXT<1)) 

25  FORMAT <*AOJUSTEO  ARE  OBSERVATIONS  0F>*» 

CALL  PLTSYMC.25,TEXT< 11,0.0, XLEFT,YB0T-YSC*5. 81 
IF  (XK  .£0.  2  )  GO  TO  195 
IF (KK,EO, 3)  GO  TO  215 
IF(KK.E0.4)  GO  TO  235 
195  ENCQDE(22,205»TEXTC1) ) 

GO  TO  255 

215  ENCODE <28,225,TEXT!1) ) 

GO  TO  255 

235  ENCOOE  <1 8, 245, TEXTt 1 )l 

255  CALL  PLTSYM<.25,TEXT(1>,0.0,XLEFT,YBQT~YSC*6.2) 

178  FORMAT ( 3A10, 1H> ) 

180  FORMAT! 5HCA5E  ,12, 6H,  NX»,I1,5H,  NP«,I1,1H>) 

205  FORMAT! 22HPRESSURE  AND  DISTANCED 
225  F0RMAT!27HPRESSURE, DISTANCE  AND  TIHE>> 

245  FORMAT! 18 HPRESSURE  AND  TIhE>> 

265  CALL  PLTPGE 
RETURN 


u  u 


SUBROUTINE  PLOTSH(KK, SCOI ST> SC PRES, SC  TIME* NRSHOK, P AR4,NP, V4, 

1  ERZ4,ERFAC) 

C  THIS  PLOTS  DISTANCE  OVER  TINE  (DATA  AND  FITTED  CURVE) 

C 

C  KK  INDICATES  WHAT  HAS  BEEN  ADJUSTED 

C  SCDIST,  SCPRES,  SCTIME  *  SCALES  TO  BE  USED  ON  INPUT  DATA 
C  PAR4(10)  *  SHOCK  FITTING  PARAMETERS 

C  NP  NUMBER  OF  SHOCK  FITTING  PARAMETERS 

C  V4(10,10)  *  VARIANCE  MATRIX  OF  SHOCK  PARAMETERS  PARA 

C  ERZ4  *  STANDARD  ERROR  OF  A  SET  WITH  WEIGHT  ONE 
C  ERFAC  *  FACTOR  FOR  PLOTTING  OF  CONFIDENCE  LIMITS 
C 

C  ROUTINE  USES 
C 
C 

DIMENSION 
C 

DIMENSION 
DIMENSION 
DIMENSION 
C 

CONMON/COMSHDT/TPXH(4»50)»ERTPXH(4» 50 ) , TITLE ( 3 ) , AL ABt 2, 50) 
COMMON/ AN BC HA/ AM B( 8) 

C  THESE  TWO  COMMON  BLOCKS  CONTAIN  INPUT  DATA 
C 

COMMON/CMISFM/MISPOT( 3, 50 ) , DI S TN( 50 ), NODIST»SCDD 
C0MM0N/CF2DER/GAMCAP,  SNDSPD,CPAR( 4) » ALOW, SCO. SCP» SCT 
C  THESE  TWO  COMMON  BLOCKS  ARE  NEEDED  BY  THE  CONSTRAINT  ROUTINE  F 2SHCK 
C 

COMMON/PLOT/PO(6),PLABL(4) 

C  FROM  THIS  COMMCN  BLOCK  USE  ONLY  THE  PLOTTING  LABEL 
C 

DATA( ANAME-6HPLDTSH) 

C 

IFCKK.LE.2)  RETURN 

C  NO  PLOTTING  IF  TIME  WAS  NOT  ADJUSTED 
C 

SNDSPD*SNDSPD*SCO*SCTIME/(SCT* SCDIST) 

ALOW* ALOW *SCD/SCDIST 

GANCAP-GAMCAP*SCPRES/SCP 

SCD*SCDIST 

SCT-SCTIME 

SCP*SCPRES 

C  THIS  WILL  CAUSE  F2SHCK  TO  FURNISH  RESULTS  IN  THE  PROPER  SCALES 
C 

CALL  LOGSC( SCDIST, SCPRES*  SCTIME,ANAME,DMIMA,PMIMA,TMIMA,SCL,NBD) 
IF(NBO.NE.O)  RETURN 

LOGSC  ESTABLISHED  PLOTTING  SCALES  FOR  LOGARITHMIC  PLOTTING 

CALL  PLTBEG(21.0,28.0,0.394,13,PLABL> 

XSC*  SCL  $  XOR*TMINA( 1 )  *  XR AN* TMIMAI 2 )-TNIM A( 1 ) 

YSC-SCL  S  Y0R»0M IM A(  I )  $  YR AN-DMIMA ( 2 )-DMIM A( 1 ) 

DX«1.  i  XL  EFT  *X0R  t  XRIGHT*XLEFT*AMAX1( XRAN,AINT(10.*XSC) ) 

DY*1.  S  YBOT* VOR  $  YTOP* YBOT* AMAX1( YR AN, AINT(  10. *YSC ) ) 

CALL  PLTSCA(5.0,9.0,X0R, YOR,XSC,YSC) 

NTYPE*7 

CALL  PLTAXS (DX,DY,XLE FT, XRIGHT, YBOT, YTOP, NTYPE ) 


CONSTRAINT  ROUTINE  F2SHCK  TO  COMPUTE  TIME  FOR  GIVEN 
DISTANCE 

PAR4(10),V4(I0,10)«TEXT(6) 

PMIMA(2),DMIMA( 2),TMIMA(2) 

XP ( 201 ) » YP( 201),EYP(201),YPE(201),Q(5,1) 
FX(5),FP(10),FXX(5,5),FXP(5,10),FPP(10, 10) 


DXL= 1 • 0  $  DYL*1. 0 

CALL  LABLOG(DXL»DYL#XLEFT,XRIGHT, YBOT,YTOP, 0.0, 0.0) 

35  FORMAT! 13HDISTANCE  <N)>> 

ENCODE ( 13»35»TEXT(1)) 

TX«XLEFT-XSC*1.7 

TY-I  YBOT^YT OP )/2.-YSC*6. 0*0.3 
CALL  PLTSYM(0.3,TEXT(1>.90. 0,TX>TY) 

36  FORMAT! 9H TIME  (Sl>) 

ENCODE !  9»  36»TEXT (l)  ) 

TX*!  XLEFT«-XRIGHT)/2.-XSC*4.0*0.3 
TY*Y80T-YSC*1.5 

CALL  PLTSYM!0.3»T£XT! 1)»0.0»TX»TYI 
ENC0DE!31»178»TEXT1H J  CTITLE( J)» J«l»3) 

CALL  PLTSYM!0.4,TEXT!  lit 0.0,XLEFT,YB0T-YSC*4.0> 

DO  197  KP* 1»  NRSHQK 
IFIMISPDT!2»KP).NE.0>  GO  TO  197 
IFIMISPOT! 3»KPI . NE.01  GO  TO  197 
XP(1)*AL0G10(TPXH!1,KP)/SCTINE  > 

YP!ll»0.5*AL0G10!!TPXH!3»KP)**2*!TPXH!4»KP)-AMB!7))**2lfSCDIST**2) 
NS*MISPDT! 1,KP> 

CALL  PLTDTS!3#NS#XP»YP#1»0) 

197  CONTINUE 

C  THE  PREVIOUS  LOOP  PLOTTED  DATA 
C 

C  NEXT  PLOT  ADJUSTED  CURVE 

CALL  PLTWNDtXLEFT*  XRI GHT» YBOT»  YTOP I  *  IP«1 

DO  238  KP* 1*201 

YP1IPMYB0T  +  !  YT0P-YBOT»*FLQAT!KP-l)/2OO. 

Q!1»1)*0.  %  Q!2#1»*10.**YP! IP)*SCDIST»  Q!3,l»«0. 

C 

CALL  F2SHCK(Q,1,PAR4, F,FX,F P, F XX, FXP, FPP. NB AD » 

IF (NB AD.NE • 0)  RETURN 

C  THE  CONSTRAINT  ROUTINE  COMPUTED  TIME  FOR  GIVEN  DISTANCE 
C 

XP!IP»«AL0G10!F/!SNDSPD*SCTINE»> 

DUN» 0 •  %  DO  236  KB«1,NP  S  DO  236  KC*1,NP 
236  DUM*DUM*FPIK8)*V4!K8,KC)*FP!KC » 

E  YP!  IP)*SQRT1 DUM )/(F*AL0G(10. ) » 

IP*IP«-1 
238  CONTINUE 

DO  2451  KE* 1, 2 

KPN* I  P-1  $  IF (KPM.LE • 0 )  GO  TO  2451 
DO  246  KB*  1, 3  S  ERF»E RFAC *FLOAT! KB-2) 

I F (KE .NE. 2  >  GO  TO  2381  S  IF  I  E  R  Z4.  LT  .  1 . 5  )  GO  TO  246  $  ERF«ERF*ERZ4 
2381  CONTINUE 

DO  243  KP-l.KPM 

243  YPE!KP>*XPIKP)*EYP(KP»*ERF 

CALL  PLTDTS!1,0, YPE,YP,KPM, 0) 

246  CONTINUE 
2451  CONTINUE 

ENCODE ( 60»5,TEXT!1) )  ERF  AC 

5  FORMAT! *CONFI PENCE  LIMITS  FOR  *,F4.1,*  STANDARD  ERRORS>*> 

CALL  PLTSYM(.25,TEXT! 1 ), 0. 0, XLEFT, YBOT- YSC* 5. 0 ) 


115  I F (ER Z4.G £ • 1 . 5)  GO  TO  14 

ENCOOE (31»10»TEXT(1II  ERZ4 
10  F ORM  AT { *WI THQUT  THE  FACTOR  ERZ  -♦,F6.3»1H>) 

GO  TO  16 

14  ENC0DE(40,15»TEXT(lll  ERZ4 

120  15  FORMAT ( *W I TH  AMO  WITHOUT  THE  FACTOR  ERZ  »*,F6.3,1H>I 

16  CALL  PLTSYMi. 25,TEXT( 1 1,0 .0, XLEFT, YB0T-YSC*5. 4 1 
IFiKK.NE.il  GO  TO  24 
ENC0DE(38,2C,TEXT(111 

20  FORMAT ( *A0 JUSTE 0  ARE  OBSERVATIONS  OF  PRESSURES) 

125  CALL  PLTSYM<.25» TEXTi 11,0.0, XLEFT, YB0T-YSC*5. 8  I 

GO  TO  265 

24  ENCaDE(29,25,TEXT(ll) 

25  FORMAT ( *ADJUSTED  ARE  OBSERVATIONS  OF**) 

CALL  PLTSYMi. 25, TEXTi 1)»0.0,XLEFT,YB0T-YSC*5.8) 

130  IFIKK.EQ.2I  GO  TO  195 

IF (KK.EQ. 3)  GO  TO  215 
IF (KK.EQ. 4  I  GO  TO  235 
195  ENCOOE (22,205,TEXT(1)  I 
GO  TO  255 

135  215  ENCODE ( 28, 225, TE XT ( II  I 

GO  TO  255 

235  ENCODE  (18,245, TEXTil  1 1 

255  CALL  PLTSYMi. 25, TEXTi 11, 0.0, XLEFT, YB0T-YSC*6. 21 
178  F0RMAT(3A10,1H>I 

140  180  FORMAT! 5HCASE  ,I2,6H,  NX-,I1,5H,  NP-,I1,1H>> 

205  FORMAT ( 22 H PRESSURE  AND  DISTANCE*! 

225  F0RMAT(27HPRESSURE, DISTANCE  AND  TIME*) 

245  F0RHATU8HPRESSURE  AND  TIME*! 

265  CALL  PLTPGE 
145  RETURN 

END 
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SUBROUTINE  LOGSC < SCDI » SCPR* SCTI, ANAME* DMIMA, PM  IN A, 
ATMIMA*SCLG10*NBAC) 

THIS  CONPUTES  HININUN  AND  MAXIMUM  PLOTTING  LIMITS 
ANO  PLOTTING  SCALE  FOR  LOGARITHMIC  PLOTS 

SCOI*  SCPR*  SCTI  »  SCALES  TO  BE  USED  WITH  DATA  IN  CNPLSH 
ANANE  «  NAME  OF  CALLING  PROGRAM 

THE  FOLLOWING  IS  COMPUTED  BY  LOGSCA 

DMINA(2)#PMIMA(2)*TMIMA( 21  -  MINIMUM  AND  MAXIMUM  VALUES  OF  DIST,P,T 

REPRESENTING  COORDINATE  WINDOWS  FOR  LOGARITHMIC  PLOTS 
SCLGIO  »  LOGARITHMIC  SCALE  DETERMINED  SUCH  THAT  ALL  QUANTITIES 
CAN  BE  LOGARITHMICALLY  PLOTTED  WITHIN  A  15  X  15  CM  SQUARE 
NB AD  «  ERROR  INDICATOR.  NBAD.EQ.O  IF  NO  ERROR 

DIMENSION  DMIMA(2)*PMIMA(2)*TMIHA(2) 

COMM  ON/CMP LSH/PM IN > PM AX»DMIN, DMAX,  TMIN* TMAX 
C  THIS  COMMON  BLOCK  CONTAINS  THE  EXTREME  DATA  VALUES 
C 

NBAO-O 

IFISCDI.GT .O..AND.SCPR.GT .0. .AND.SCTI.GT .0. )GOTO  25 
NBAD-1 

PRINT  15*ANAME*SCDI*SCPR*  SCTI 
RETURN 

15  FORMAT! 1H0*10X*1 5HN0  PLOTTING  BY  ,A6,8H  BECAUSE* 

A33H  PLOTTING  SCALES  ARE  NOT  POSITIVE, A, 1H  »10X» 

B20HDIST ANCE  SCALE  SCDI»*1PE12. 5* A, 1H  *10X* 

C20HPRESSURE  SCALE  SCPR-, 1PE12 . 5* /, 1H  ,10X, 

020HTIME  SCALE  SCT I», 1PE 12. 5* / I 

25  IFIPMIN.GT .O..AND.PMAX.GT.O. (GOTO  55 
35  NBAD-2 

PRINT  45*  A  NAME*  PMIN»PMAX»DMIN»DMAX»TMIN»THAX 
RETURN 

45  FORNAT<IHO,10*»15HNO  PLOTTING  BY  *A6*8H  BECAUSE* 

A45H  DATA  ARE  OUTSIOE  RANGE  FOR  LOGARITHMIC  PLOTS*  A* 

B1H  * 10X,5HPHIN«,1PE12.5,7H  PNAX»,1PE12.5,A, 

C1H  ,10X,5H0MIN«,1PE12.5*7H  DM AX-, l PE12 . 5, A , 

D1H  , 10X,5HTMIN«,1PE12.5»7H  TM AX-* 1PE12 . 5* A ) 

55  IF!DMIN.LE.O..OR.DMAX.LE.O.)GQTO  35 
IF(TMIN.LE.O..OR.TMAX.LE.O. I  GO  TO  35 
A  P»AL  0G10! PMINASCPRI 

PMINA!11«AINT!APH-AMIN1C0.*SIGNI1.,  API  I 
AP*AL0G10!PMAXASCPR I 

PMIMA!2)«AINT!AP)*AMAX1!0.*SIGN<1.,AP)> 

PMINA!2>«AMAX1IPMIMA! 2),PMIMA( 1»*1. ) 

AP-ALOGIOCOMIN/SCOII 

DMIMA! 1>* A INT!AP)*AHIN1 !0.* SIGN! l.» API) 

AP*AL0G10(DMAX/SCDI) 

DMIMA(2)*AINT(AP)+AMAX1(0.*SIGN(1.* API) 
DMINA!2)*AMAX1!DMIMA!2)»DMIMA(1)+1.) 

AP-AL0G101TMINASCTII 

TMIMA(1)-AINT!AP)*AMIN} !0.»SIGN(1., API) 

AP*AL0G10(TMAX/SCTI) 

TMIMA!2)*AINTIAP)+AMAX1!0.*SIGN!1.,API) 

TMIMA(2)«  AMAXKTMIMA!  2),TMIMA(  11*1.  ) 

PLQGR»PMIMA!2)-PN!MA! 1) 


DL0GR»0MIMA<2I-DMIMA< 1) 

TL0GR«TNINA(2)-TM:HA( u 

SCLG10«AMAX1(0.2»PL0GR/15.»0LQGR/15.»TL0GR/15. > 

RETURN 

END 
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APPENDIX  B 

BLAST  FOLD  OVERPRESSURE  FITTING  PROGRAM  BLAFOP 


PAGF 

1.  OPREFIT . 97 

2.  READAM . 100 

3.  READS  P . 104 

4.  READPR . 106 

5.  SCALPR . 108 

6.  FITPR . 10S 

7.  GUESS . Ill 

8.  EX  PON . 113 

9.  PRTPNTS . 114 

10.  DIMPAR . 115 

11.  PLTPNTS . 116 

12.  ERELCM . 119 

13.  PRINPAR . 120 

14.  PLTPAR . 122 

15.  FTPFLD . 124 

16.  FLDGES . 127 

17.  PFIELD . 129 

18.  PLDAUX . 131 

19.  QFUNCT . 132 

20.  ACOEF . 135 

21.  BCOEF . 136 

22.  CCOEF . 137 

23.  COEFFI . 138 

24.  SHOCK . 139 
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APPENDIX  B  (continued) 


*tCJ  m 

SH0CK2 

26. 

SHTINT 

27. 

ROMBIN 

28. 

PRTFLD 

29. 

PLTLOC 

30. 

STRBEG 

31. 

SHODER 

32. 

F2SHCK 

33. 

F2DER  . 

34. 

ROMULT 

35. 

STRLIN 

36. 

DIMFLD 

37. 

PLTFLD 

38. 

COLSACA 

39. 

COISACB 

40. 

KTRINDB 

41. 

LUDATD 

42  . 

LUELMD 

PROGRAM  OPREFIT(INPUT»OUTPUT*T AP E 6* OUT PUT* T APE  13 1 
€  BLAST  FIELD  OVERPRESSURE  FITTING*  MAIN  PROGRAM 
C 

LEVEL  2*X#R,ALA8*LSTX»PRP»VPRP*PRPD*VPRPD 

COMMON  X<  5* 100)*R(5»9»100)» ALAB( 2*100) »LSTX(1 00) »PRP( 4*50 )» 

1  VPRP(4,4,50I*PRPD(4»50)»VPRPD(4»4»50> 
COMNON/PLOT/PD(6)»PLABL(4) 

C 

DIMENSION  TITLE (3)»PAR(10)*VPAR(10* 10)»  PROS (50) *PRDSO( 50) * 

1  P ARD IN (10 ) > VPDIM! 10* 10) 

DIMENSION  PIN(50)*PIND(50)*TAR(50)*TARD(50)»PRLAB(50) 
DIMENSION  EXNUI3) 

DIMENSION  TEND! 50)»TENDD(50) 

C 

EXTERNAL  SHOCK*PFIELD 
C 

CALL  REAOAH(SCDIS*SCPRES* SC  TIME* TITLE* NBAD) 

C  READ  AMBIENT  DATA 

IF(NBA0.NE.0.AN0.NBAD.NE.3I  STOP 

C 

CALL  READSP(NBAD) 

C  THIS  READS  SHOCK  FITTING  RESULTS.  THE  PARAMETERS  AND  THEIR 
C  ACCURACIES  WILL  BE  STORED  IN  PROPER  COMMON  STORAGES. 
IF(NBAO.EQ.O)  GO  TO  9 
PRINT  2*NBAD 

2  FORMAT ( 1H  ,*ERROR  IN  READSP»NBAD*  *»I5) 

STOP 

C 

5  CONTINUE 

CALL  RE ADPR (NRPROF ) 

C  READ  ALL  OVERPRESSURE  HISTORY  DATA.  NRPROF  IS  THE  TOTAL  NUMBER 
C  OF  OVERPRESSURE  HISTORIES  (PROFILES)  IN  THE  INPUT. 
IF(NRPROF.GT.O)  GO  TO  10 
PRINT  T.NRPROF 

7  FORMAT! 1H  >*ERROR  IN  READPR»NRPROF-  **I5) 

STOP 

10  CONTINUE 
C 

DO  45  KA*1> NRPROF 

CALL  SC ALPR( SCDIS*  SCPRES*  SC  TIME*KA*  X*  R*  ALAB*  LSTX* 

A  NRS  ETS*TIHSH*PRSH*  DISH*NBAD) 

C  SCALE  IN  SI-UNITS  ANO  STORE  ONE  HISTORY  IN  X*  1  THROUGH  NRSETS. 
C  SHOCK  TIME*  PRESSURE  AND  DISTANCE  ARE  SCALED*  TOO 
IF(NBAO.EO.O)  GO  TO  19 
PRINT  12*  NBAD 

12  FORMAT ( 1H  »*ERROR  IN  SCALPR*NB AD*  *»I5> 

STOP 

15  CONTINUE 
C 

CALL  FITPR( X*R» ALAB»L STX* NRSETS»TIMSH*PRSH* DISH*PAR* 

A  V PAR*  ERZ*  TITLE*  SCDIS* SC  PRES*  SCTIME* NBAD) 

C  FIT  THIS  OVERPRESSURE  HISTORY 
IF(NBAD.EO.O)  GO  TO  20 
PRINT  17* NBAD 

17  FORMAT! 1H  » *ERROR  IN  FITPR»NBAD*  *»I5) 

STOP 

20  CONTINUE 
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C 

CALL  DIMPAR(SCDIS,SCPRES,SCTIME,PAR,VPAR,ERZ,PARDIH»VPDIH) 

C  COMPUTE  DIMENSIONAL  VALUES  OF  PARAMETERS  AND  VARIANCES  (IN  SI  UNITS) 

C 

CALL  PLTPNTS(X»R»ALAB»NRSETS*PRSH,TIMSH» SC  PRES, SC TIME, 

A  PAR  DIM, VPOIN, TITLE) 

C  PLOT  PRESSURE  HISTORY  AND  OBSERVED  NODES  WITH  ERROR  ELLIPSES 
C  THE  PLOTS  WILL  BE  IN  SI-UNITS.  PARDIM  IS  ASSUMED  TO  BE  IN  SI. 

C 

DO  35  KB»1,3  $  DO  25  KC-1,3 
VPRP(KB,KC,KA)*VPAR(KB,KC) 

25  VPRPD( KB*  KC,KA)“VPDIM(KB»KC) 

PRP(KB»KA)*PAR(KB) 

35  PRPD(K8»KA) »P ARD IMCKB ) 

C  STORE  PROFILE  PARAMETERS  ,  SCALED  AND  DIMENSIONAL 
PRDS(KA)  *DISH  t  PROSD(KA)«DISH*SCDIS 
C  STORE  PROFILE  DISTANCES*  SCALED  AND  DIMENSIONAL 
PIN(KA)»PRSH  S  PIMO(KA)«PRSH*SCPRES 
C  STORE  INCIDENTAL  SHOCK  OVERPRESSURES 

TAR!KA)-TIMSH  t  TAR0< KAI-TIMSHPSCTIME 
C  STORE  SHOCK  ARRIVAL  TIMES 
TEND(KA)»X(1,NRS£TS) 

DO  37  KB«1,NRSETS 

37  TEND(KA)*AMAX1!TEND(KA)»X(1,K8)) 

TENDD(KA)»TEND(KA)*SCTIME 
C  STORE  HISTORY  END  TIMES 
PRLAB(KA)=ALAB!1#1> 

C  USE  LABEL  OF  fIRST  OBSERVATION  TO  IDENTIFY  PROFILE 
C 

45  CONTINUE 
C 

CALL  PRINP  AR( PRLAB»PROS»  TAR, PIN#  PRP*VPRP* 

APROS  D*T  ARD*  PIND#  PRPD, VPRPD*  NRPROF#  PAR*  E  XNU*  TITLE ) 

C  PRINT  SUMMARY  OF  PRESSURE  HISTORY  FITTINGS 

C  AND  OBTAIN  EXPONENTS  EXNU  AND  INITIAL  APPROXIMATIONS  OF  PAR 
CALL  PL  TP AR (NRPROF* PR PO*PRDSD* TITLE) 

C  PLOT  HISTORY  PARAMETERS  VERSUS  DISTANCE 
C 

CALL  FTPFLD(SCOIS»SCPRES»SCTIME»TITLE»PRLAB*PRDSD*TARD» 

A  PIND. NRPROF, EXNU* PAR, VPAR»ERZ»NP»NBAD) 

C  FIT  ALL  TIME, OVERPRESSURE, DISTANCE  DATA  TO  OBTAIN  OVERPRESSURE  FIELD 
C 

IF(NBAD.EO.O)  GO  TO  50 
PRINT  47*  NB  AO 

47  FORMAT! 1H  ,*ERROR  IN  FTPFLD.NBAD-  4*15) 

STOP 

50  CONTINUE 

CALL  DIMFLD(SCOIS*SCPRES*SCTINE*EXNU*PAR*VPAR*ERZ*NP* 

A  PARDIM, VPOIM.TITLE) 

C  COMPUTE  DIMENSIONAL  VALUES  OF  OVERPRESSURE  FIELD  PARAMETERS 
C 

SCD*1.0  $  SCP-1.0  S  SCT-1.0 

C  SCALES  ARE  ONE  IF  DIMENSIONAL  QUANTITIES  ARE  USED  IN  PLTLOC  ARGUMENTS 
CALL  PL TL OC(P RDS 0, T AR D,TENDD, NRPROF, PAR  DIN* VP DIM.NP, 

A  SCO, SCP.SCT, SHOCK, TITLE) 

C  PLOT  HISTORY  LOCATIONS  IN  THE  X,T  PLANE 
C 
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SUBROUTINE  RE  AD AN (SCO  1ST*  SC PRES*  SC TINE*  TITLE* N BAD) 

THIS  ROUTINE  REAOS  TITLE*  PLOTLABEL  AND  DATA  CAROS  DESCRIBING 
ANBIENT  CONDITIONS  ANO  THE  CHARGE 

FIRST  TWO  CAROS  ARE  NANOATORY  ANO  ALPHANUNERIC  (TITLE  ANO  PLOTLABEL) 
THE  REST  OF  THE  CAROS  HAVE  THE  FORNAT  (2A10»6E10. 31 
CHARGE  CARO  IS  NANOATORY 

IF  ANBIENT  DATA  ARE  NOT  PROVIOEO  THEN  STANDARD  AIR  WILL  BE  ASSURED 

SEQUENCE  OF  NANOATORY  INPUT  CARDS 
TITLE  CARO  (ALPHANUNERIC) 

PLOTLABEL  CARO  (ALPHANUNERIC) 

CHARGE  CARO  -  VOLUNE*  ENERGY*  HIGHT*  ERROR  OF  HIGHT 

THE  FOLLOWING  ARE  OPTIONAL  INPUT  CAROS  IN  ARBITRARY  SEQUENCE 
ANBIENT  -  P»TENPERATURE»  GANNA*  NOLAR  NASS 

OEFAULT  VALUES  CORRESPOND  TO  A  STANDARD  AIR 
SCALES  -  SCALES  OF  R*P*T  TO  BE  USED  IN  CONFUTATIONS 
OEFAULT  VALUES  ARE  CONPUTEO  AFTER  STATENENT  1110 
PLOTTING  DATA  •  ERROR  FACTORS  FOR  THE  PLOTTING  OF  CONFIDENCE 
LINITS  IN  HISTORY  PLOTS 
OEFAULT  VALUES  ARE  FACTORS  2.0  FOR  ALL  PLOTS 

END  OF  INPUT  IS  INDICATED  BY  A  BLANK  CARD 

DINENSION  TITLE! 3) 

DINENSION  0(8 )> ANSTAR (A) 

CONNON/ANBCHA/AIRPR*  AIRTEN*  AIRGAN* AIR HOL»CH ARVO*  CHAREN* 
ACHARHIvCHARHER 
CONNON/PL OT/PD( 6 ) * PLABL ( 4 ) 

DATA ( TITL  -10HTITLE  )»  (PL AB-10HPL0TLABEL  ) 

DATA  (BLANK-10H  ) * ( ANB-10HANBI ENT  ) 

DATA  ( CHA*1 OH CHARGE  ) 

DATA ( PLT«10HPL0T TING  D), ( SC AL- 10HSC ALES  R*P) 

15  FORNAT( 1H1* 10X* 20H INPUT  REAO  BY  REAOAN* /» 1H  * 10X* 20( 1H-), / ) 

25  FORNAT ( 8A10) 

26  FQRNATdH  *10X*8A10) 

35  FORNAT ( 2A10»6E10. 3) 

36  FQRNATdH  »  5X,  2A10*6(  2X.  1PE14 .7)  ) 

C 

PD(l)-2.0 

C  OEFAULT  VALUE  FOR  PLOTTING  ERROR  LINITS  IN  PRESSURE  HISTORIES 
P0(2 ) *2.0 

C  DEFAULT  VALUE  FOR  PLOTTING  FIELO  HISTORIES  (P* V»RH0*V*P2«RH0/2. ) 

A I  RPR* 101 32 5.0  $  AIRTEN-293.0  %  AIRGAN-1.4 

AIRH0L»0. 02896  t  AI RDEN»( AIRNOL/8 . 3143 )♦( AIRPR/AIRTEN) 

C  THESE  ARE  STANOARD  AIR  OEFAULT  VALUES  FOR  ANBIENT  CONDITIONS 
C 

NSCAL-0  $  NANSTAR«0 
NANB-0  *  NCHA-0 
00  37  4»l*4 
37  ANST  AR( J) • 1H 

PRINT  15 
00  46  KK-1*2 
REAO  25*(0U)*J-1*8) 

PRINT  26>(0(J)»J«1»8) 

I F ( D ( 1) .EQ.TITL  )  GOTO  42 
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IFIDID.EQ.PLAB)  GOTO  64 
PRINT  48  $  NBAD-1  $  RETURN 
C 

42  DO  43  KA-1.3 

43  TITLEIKA)*DIKA»1) 

GOTO  46 

44  DO  45  KA«1# 4 

45  PIABL(KA)-0<KA*1) 

46  CONTINUE 
C 

47  READ  35»(D(J)*J>1»8) 

PRINT  36# ( D ( J ) » J *1*8) 

IF (D ( 1 ) .EQ. ANB) GOTO  55 
IFID(1).E0.CNA)G0T0  65 
IF(0(1).EQ.PLT)  GOTO  66 
IF(OU).EQ.SCAL)  GOTO  68 
IF(0( 1) .E 0. BLANK  I  GOTO  69 

475  PRINT  48  $  NBAD-2  $  RETURN 

48  FORN AT ( 1H0» 10X» 1 3HINV ALID  INPUT) 

C 

55  IF(NAN8.EQ.1)60T0  475 

C  ONLY  ONE  ANB I ENT  DATA  CARD  HILL  BE  CONSIDERED 
NANB-1 

IF(D( 3) .GT.O. )AIRPR»D<3>  $  IF(D(4).GT.O. )AIRTEM*D<4) 

IF(DI5).GT. 0. )  AIRGAM*D( 5)  S  IF (D( 6) •GT.O* IAIRN0L«D(6) 

C  IF  INPUT  IS  ZERO  THEN  USE  AIR  DEFAULT  VALUES 
DO  57  KAa  1» 4  i  AMSTAR<KA)»1H 
IF(D(KA+2).GT.O.)  GOTO  57 
AHST  ARC  KA )  «1H*  t  NAHSTAR-1 
57  CONTINUE 

AIRDENaUIRH0L/8.3l43)*UIRPR/AIRTEN) 

GOTO  47 
C 

65  IF(NCHA.EQ.1)GOTO  475 
CHARV0-0I3)  $  CHAREN-0I4) 

CHARHI-DC5)  $  CHARHER"D(6) 

NCHA-1 
GOTO  47 
C 

66  DO  67  KA«1»6 

67  PD<KA)-0(KA«2) 

GOTO  47 

C  PLOTTING  OATA  CARD  SPECIFIES  PLOTTED  OUTPUT 
C  POUI*  ERROR  FACTOR  FOR  PRESSURE  HISTORIES 
C  PD (2 ) •  ERROR  FACTOR  FOR  OTHER  FLOW  HISTORIES 
C 

68  NSCAL-1 

SCD-Dm  *  SCP-DU)  t  SCT-DI5) 

C  SCALE  CARO  OVERRIDES  SCALES  COMPUTED  FROM  AMBIENT  AND  CHARGE  DATA 
IFISCD. GT.O.. AND. SCP.6T.0.. AND. SCT. GT.O.)  GOTO  47 
NSCAL-0  %  PRINT  681 

681  FORMAT (1H  #10X# 36HN0N-P0SITIVE  SCALES  ARE  NOT  ACCEPTEO) 

GOTO  47 
C 

69  IFINCHA.EQ.O.OR.NANB.EQ.O)  PRINT  70 

70  FORMAT! 1H0» 10X» 16H INCOMPLETE  INPUT) 

75  PRINT106. ! TITLE  I J )» J* 1»3) 


101 


115 


106  FORM  AT! 1H1* /,1H  ,  10X, 5HEVENT, /»1H  ,10X*  5C 1H- ) * /, 1H0, 15X, 3A10, / /) 
PRINT  107 

107  FORMAT ( 1H0, 10X*18HAMB IENT  CONDITIONS* /» 1H  , 10X, 18 ( IH-) *  / ) 
IF(NAMB.EQ.O)  PRINT  1071 

1071  FORMAT ( 1H0* 10X* 36HTHE  FOLLOWING  AMBIENT  CONDITIONS  ARE* 

120  A  /  *1H  * 10X*  27HST  ANDARD  AIR  DEFAULT  VALUES*/) 

PRINT  108* AMSTAR(1)*AIRPR* AMSTAR(2)»AIRTEM» AMSTAR(3)»AIRGAH» 

A  AMS  TAR (4)*  AIRMOL 

108  FORMAT! 1H  , 13X, Al, IX, 8HPRESSUR E, 11X* 7HAIRRR  -*1PE12.5*4H  PA*/* 

A  1H  * 13X*  A1«1X* 11HTEMPERATURE* 8X, 7H AIRTEM*, 1PE12.5,  3H  K»/> 

125  B  1H  *13X* A1»1X*16HSPEC.  HEAT  RATIO* 3X,7HAIRGAM*,lPE12.5»/» 

C  1H  * 13X*  Al* IX* 10HMQL  AR  MASS* 9 X* 7HAIRM0L** 1PE12. 5,9H  KG/MOLE*/) 
AIRS  NO* SORT! AIRG AMP AI RPR/ AIRDEN) 

PRINT  109*  AIRSND* AIRDEN 

109  FORMAT ( 1H  * 15X* 11HS0UND  SPEED, 8X* 7HAIRSND*, 1PE12.5* 5H  M/S*/, 

130  A  IH  * 15X*  7HDENSI TY, 12  X, 7HAIRDEN*, 1PE12. 5>9H  KG/M**3,/) 

IF(NANSTAR.EQ.l)  PRINT  1081 

1081  FORMAT ( 1H  ,13X,35H*  THE  STARRED  DATA  ARE  STANDARD  AIR* 

A  15H  DEFAULT  VALUES*/) 

135  IF(NCHA.EQ.l)  GOTO  1100 

NBAD*4  $  PRINT  1101*NBA0  *  RETURN 

1101  FORMAT! 1H0* 10X* 29HRETURN  FROM  READAM  WITH  NBAD**I2» 

A  33H*  BECAUSE  CHARGE  DATA  ARE  MISSING) 

C 

140  1100  PRINT  110 

110  FORMAT ! 1H0* 10X* 18HCHARGE  DE SCRIPT  ION* /»1H  * 10X, 18 (1H-) * / ) 

PRINT  111*  CHARVO»CHAREN 

111  FORMAT! 1H  * 15X, 13HCHARGE  VOLUME, 6X, 7HCHAR VO*, 1PE 12. 5* 6H  M**3,/, 

A  1H  , 15X, 13HCHARGE  ENERGY, 6X» 7HCHAREN*, 1PE12. 5, 3H  J*/) 

145  SC0IST*CHARV0*4! 1./3.  ) 

PRINT  1110,CHARHI,CHARHER 

1110  FORMAT! 1H  * 15X, 16HCHARGE  EL E VATION, 3X* 7HCHARHI-, 1PE 12. 5, 4H  ♦-  * 

A  1PE 12 • 5, 3H  M »/) 

SC TIME* SC  01 ST/ AIRSND 
150  SCPRES-AIRPR 

SCEVEN*CHAREN/( CHARV04AIRPR ) 

PRINT  112 

112  FORMAT ( 1H0* 10X* 7HSCAL ING, /» 1H  * 10X* 7! 1H-) * / ) 

PRINT  113*SC0IST*SCTIME*SCPRES*SCEVEN 

155  113  FORMAT  1 IH  , 15X* 12HLENGTH  SCALE, 4X,20HSCDIST-CHARV0*4!l/3) * 

A  2X*1H*,1PE12.5*3H  M ,/, 

B  1H  , 15X* 10HTIME  SCALE,6X,20HSCTIME*SCDIST/ AIRSND, 

C  2X*1H-,1PE12.5*3H  S »/» 

D  1H  , 15X,14HPRESSURE  SC  ALE, 2X, 13HSCPRES* AIRPR  , 

160  E  9X,1H*,1PE12.5,4H  PA,/, 

F  IH  * 15X, 14HSC ALE  OF  EVENT* 2X, 21HCHAREN/ !CH ARVO* AIRPR ) * 

G  IX, 1H-,1PE12.5, /) 

IF!SCEVEN.EQ.O.O)PRINT  114 

114  FORMAT 1 IH  , 15X»30HEVENT  CANNOT  BE  SCALED  BECAUSE* 

165  A29H  CHAREN  IS  NOT  GIVEN  BY  INPUT,/) 

IF!NSCAL.EQ.O)  GOTO  115 

C  USE  SCALES  FROM  SCALE  CARO  IF  SUCH  A  CARD  WAS  READ 
SCDIST-SCD  $  SCPRES  *SCP  $  SCTIME-SCT 

170 

115  PRINT  116*SC0IST, SCTIME, SCPRES 


175 


116  FORMATUH  *////*lH  »10X»  27HSCALES  USED  IN  THIS  RR°GRAH,/» 

A  1H  »10X,27<lH->»//»lH  • 20X» 16HLEN6TH  SCALE  *,1PE12.5»3H 
B  1H  » 20X»  16HTINE  SCALE  «,1PE12.5*3H  S»/» 

C  1H  »  20X» 16HP RES  SURE  SCALE  •»1PE12.5»*H  PAI 


NBAO-O 

RETURN 

END 
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SUBROUTINE  RE ADSP (NBAD ) 

C 

C  THIS  ROUTINE  READS  SHOCK  PARAMETERS  NAD  THEIR  ACCURACIES 
C 

COMMON/COMSMK/NPS# PAR !4t#  VP ARi 4#4)# SCD#  SCP#  SCT 
COMMON /CF2DER/GAMCAP#  SNDSPD#CFPAR!4)#AL0W#CFSCD#CFSCP#CFSCT 
COMMON/ AMBCHA/AMP, AMT# ANG»AMM*  AMCHV# AMCHE* AMCHH# AMCHHE 

C 

DIMENSION  DAT !8)#ER!4)#C0RI4»4) 

DIMENSION  DSI!4)»DSC!4)»DPR!4) 

C 

DATAIPt-lOHSHOCKPAR  )#  1 ELa10HS HOCK PARER ) »  ( CU* 1 OHS HOCK PARC 0) 
A  ISC*10HSH0CKSCALE)#( BL«10H  ) 

C 

DATA  DSI/ 10HPA*M  #10HPA*M**2  ,10HPA*M**3  » 

A  10HS  / 

DATA  DSC/ 10HSCP*SC0  » 10HSCP*SCD**2» 10HSCP*SC0**3» 

A  10HSCT  / 

KPL-1  $  KEL*1  $  KCL»1  S  KSC-I 
PRINT  12 

12  FORNATI1H1»10X#20HINPUT  READ  BY  REAOSP#/) 

15  FORMAT ( 2A 10»6E10«  3) 

25  FORMAT ! 1H  » 5X»2A10» 6( 2X» 1PE14. 71) 

35  READ  15#!DAT!J)#<lal»8) 

PRINT  25# IDAT!J)#J*1#8) 

IFIDATI1) .EQ.PL)  GOTO  55 
IF(DAT(1).EQ.EL)  GOTO  75 
IF!DAT!1).EQ.CL)  GOTO  95 
IF!0AT!1).E0.SC)  GOTO  115 
IFIDATI1I  .EQ.BD  GOTO  125 
NBAD*1 

PRINT  45  $  RETURN 

45  FORMAT! 1H0# 10X# 13HINV ALIO  INPUT) 

C 

55  DO  65  K A» 1#  4 

65  PAR! KA ) *DAT!KA*2) 

0AL0W-DAT17) 

IF1DAL0W. GE.1.0E-90)  GOTO  67 
PRINT  66#  0AT(6) 

66  FORMAT !1H  ,10X,'5-TH  NUMBER  ON  PREVIOUS  CARD  SHOULD  BE  • 

A  'POSITIVE  INDICATING  SHOCK  DISTANCE  AT  T-UPE12.5) 

N BAD *66  $  PRINT  45 

RETURN 

67  CONTINUE 
KPL-0 
GOTO  35 

C 

75  DO  85  K A* l # 4 

85  ERIK  A) *0AT!KA*2) 

KEL-0 
GOTO  35 
C 

95  C0R!1»1)-1.  *  C0R12»2)*1«  $  COR!3#3)«l.  %  C0R!4#4)-1. 

C0R!1#2)-DAT!3)  $  C ORI 2»1 » »COR ( 1# 2) 

COR! 1»3)*DAT!4I  t  COR! 3»1 I «COR! 1# 3) 

C  OR! 1#  4 )■ DAT! 5)  t  C0R!4»1)>C0RI1#4) 
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COM  2*  3  )■  OAK  6)  $  COR! 3* 2 ) -COR! 2* 3) 

C0R!2*4)-0AT!7)  t  C OR! 4*2)»C0RI 2* 4) 

CQR!3*4)»DAT!8)  %  C0R!4*3)«C0RI3* 4) 

KCL-0 
GOTO  35 
C 

115  SCD«OAT (3 )  t  SCP-DATI4)  $  SCT-0ATI5) 

65  KSC»0 

GOTO  35 

C 

125  IF!KPL.EQ.O.ANO.KEL.EQ.O.AND.KCL.EQ.O.ANO.KSC.EQ.O)GOTO  145 
N  B  AO  >  2 

70  PRINT  135  $  RETURN 

135  FORMAT 1 1H0* 10X* 16HINC QNPLETE  INPUT) 

C 

145  MPS«4 

ALO’  OALOU4SCO 

75  GAMCAP«I!1.*AMG)/!2.*AMG) l/ANP 

SNOSPD-SQRT!ANG*ANT*i 8.3143/ANN)) 

CFSCO-1.  *  CFSCP-1.  $  CFSCT-1. 

C  /CF2DER/  IS  NEEOEO  FOR  SMOCK  ARRIVAL  TINE  CONFUTATIONS 
00  155  KA«1»  4  S  DO  155  KB«1*4 

80  155  VPAR ( KA*KB)"ER!KA)*CQR!KA*KB)*ER(KB ) 

NBAO-O 
PRINT  165 

165  FORN ATI 1H0* 12 X* 16HSHQCK  PARAMETERS* 4X,6HERR0RS » 5X, 

A  1 OH 01 HENS IONS* / ) 

85  IF1SCD.E0.1..AND.SCP.E0.1..AND.SCT.EQ.1.)  GOTO  167 

00  166  KA-1»4 

166  OPR(KA)«OSC(KA) 

0IS0I-10HSC0 
GOTO  169 

90  167  00  168  KA-1*4 

168  DPR!KA)-OSI!KA) 

OISOI-IOHNETRES 

169  PRINT  175»!!PARU)*ER!J)*DPR!J))*J>1*4) 

175  FORM ATI 1H  * 14X* 1PE12. 5*4X» 1PE10. 3* 2X» A10 ) 

95  PRINT  178*  DALON* DISDI 

178  F0RNATUH0*10X*43HTHE  LAST  PARAHETER  IS  SHOCK  ARRIVAL  TINE  AT* 
A  2X*1PE12.5*2X*A10) 

PRINT  185 

185  FORMAT! 1H  »///» 1H  »15X**SH0CK  PARAMETER  CORRELATION  MATRIX**/) 
100  PRINT  195*!IC0RIJ»K)»K>1»4)*J>1»4) 

195  F0RMATI4I1H  * 10X»4 ( 2X, 0PF10.7 ) * / ) ) 

PRINT  205 

205  FORMAT  1 1H  *///» 1H  * 15X»16HSH0CK  PARAMETER  » 

A  26HV ARIA NC E-CO VARIANCE  MATRIX*/) 

105  PRINT  215*IIVPARIJ*K)*K>1*4)*J>1*4) 

215  FORMAT! 41 IH  * 10X»4I 2X* 1PE 12. 5 ) * /) ) 

PRINT  225 

225  FORMAT! 1H  *///*lH  * 16X* 22HSHQCK  PARAMETER  SCALES*/) 

PRINT  235* SCD*SCP» SCT 

110  235  FORMAT! 1H  » 15X* 12HLENGTH  SCALE*4X*5HSCD  «»1PE12.5*3H  M»/» 

A  1H  * 15X, 14HPRESSURE  SCALE* 2X, 5HSCP  •*1PE12.5*4H  PA*/* 

B  1H  * 15X* 10HTIME  SCALE*6X*5HSCT  -*1PE12.5*3H  S) 

RETURN 

ENO 
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SUBROUTINE  READPRINRPR) 

C  THIS  READS  PRESSURE  HISTORIES  FROM  CARDS 
C 

COMMON/ AMBCHA/APR, ATE, AGA, AMO, CVO,CEN, CHI, CHIER 
C OMMON/COMPR/TP ( 2*5000 )*E RTP( 2* 5000)* ALB (2* 50001 *NSETC 50  )* 
1  DISH  50)  * E RDIST ( 50) 

LEVEL  2,TP,ERTP» AL8,NSET,  DIST*  ERDIST 
DIMENSION  D(B) 

DATA  (TIMPRE>10HTINE*PRES  ), t RANGEL -10HRANGE, E LEV) 

A* ( BLANK-10H  ) 

C 

PRINT  8 

8  FORM ATI 1HI* 10X* 20HINPUT  READ  BY  READPR* / ) 

NRPR-0 

9  FORMAT! 2A10,6(E10.3)) 

10  FORMAT I 1H  ,5X,2A10,6l 2X,1PE12.5I ) 

12  READ  9* ID! J), J-1,6) 

PRINT  10,I0{J)»J-1,6) 

IFIOID.EQ. BLANK)  GOTO  15 
IFIDI2I.EQ.TIMPRE)  GOTO  35 

IFIDI2I.EQ. RANGEL)  GOTO  55 

C 

15  If INRPR.EQ.O)  RETURN 

PRINT  18*  DIST INRPR)»E RDIST (NRPR) 

PRINT  17*  NRPR»NSET(NRPR) 

IFIDISTINRPRI.GT.O.)  GOTO  16 
PRINT  40*ALBI1*NRST) 

NRPR-NRPR-1  $  NRST-NRST-KST  $  KST-0 

16  CONTINUE 
RETURN 

17  FORMAT  1 1H  * 5X*20HNUMBER  OF  SETS  NSETI *  1 3* 2H )-, 14, /) 

18  FQRMAT(1H0»5X*10H0IST ANCE  -,1PE12.5,4H  ♦-  *1PE9.2) 

C 

35  IFINRPR.GT.O)  GOTO  39 

NRPR*!  $  KST*0  S  NRST*1 
DISTI NRPR ) *0.  $  EROIST(NRPR) *0* 

GOTO  45 

39  IFIOID.EQ. ALB(1,NRST)I  GOTO  45 
PRINT  18*0ISTINRPR)*ERDISTINRPR) 

PRINT  17»NRPR*NSET!NRPR) 

IFIDISTINRPRI.GT.O.)  GOTO  41 
PRINT  40*  ALBI 1*NRST ) 

NRPR-NRPR-1  $  NRST-NRST-KST  S  KST-0 
GOTO  12 

40  FORMAT I 1H  * 5X,29HPREV IOUS  DATA  SET  KITH  LABEL  *A10* 

A  46H  NOT  ACCEPTED  BECAUSE  DISTANCE  CARD  IS  MISSING*/) 

41  IFINSETINRPR).GT.3>  GOTO  43 
PRINT  42*  ALBI 1*NRPR) 

NRPR-NRPR-1  S  NRST-NRST-KST  t  KST-0 
GOTO  12 

42  FORMAT  1 1H  * 5X*29HPREV IOUS  DATA  SET  WITH  LABEL  *A10* 

A  41H  NOT  ACCEPTED  BECAUSE  NUMBER  OF  DATA  SETS* 

A  18H  IS  LESS  THAN  FOUR*/) 
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65 


70 


75 


80 


85 


90 


43  CONTINUE 

NRPR-NRPR*1  $  KST-0  l  NRST-NRSK1 
45  IF(KST.GT.O)  NRST-NRSKl 

KST»KST«-1 
ALB(1,NRST)-D(1> 

47  FORMAT ( 5H  PT.  ,14, 1H  ) 

ENCODE (10, 47, ALB( 2,NRSTI» KST 

TP(1 »  NRST ) -0<  3)  $  ERTP(1»NRST)-D(4) 

TP (2 , NRST ) -D( 5)  S  E RTP( 2, NRST)-D( 6» 

NSET ( NRPR I »KST 
GOTO  12 
C 

55  IF(0(3).GT.0..AN0.D(4).GT.0.)  GOTO  57 

PRINT  56 

GOTO  12 

56  FORMAT! 1H  ,5X,38HCARD  NOT  ACCEPTED  BECAUSE  DISTANCE  OR, 

A  22H  ERROR  IS  NOT  POSITIVE,/) 

57  IF(NRPR.GT.O  )  GOTO  59 
NRPR-1  t  KST-0  S  NRST-1 
DISK NRPR ) *0.  S  ERDIST(NRPR)-0. 

GOTO  65 

59  IF(D(1).E0.ALB(1,NRST) )  GOTO  70 

PRINT  18, DIST(NRPR),ERDIST(NRPR) 

PRINT  17, NRPR,NSET(NRPR) 

IF(DIST(NRPR).GT.O.)  GOTO  61 
PRINT  40, AL8(1,NRST) 

NRPR-NRPR-1  %  NRST-NRST-XST  $  KST-0 
61  CONTINUE 

NRPR-NRPR+1  <  KST-0 
NRST-NRST  +  1 
65  ALB( 1,NRST)-D(1) 

70  OSO-D( 3 )*P2*<CHI~0( 5) 1**2 

OIST (NRPR ) -SORT (DSQ) 

ERSQ«(D<3)*0(4))**2/DSQMCHI-D(5))**2*(0(4)**2*D(6)**2)/DSQ 
E ROIS T ( NRPR I -SQR T( ERSO ) 

GOTO  12 
ENO 
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1  SUBROUTINE  SC ALPRC SCO  1ST, SC  PRES, SCT INE» NRC ASE, 

AX,R,  ALA8,LSTX,NRSETS»  TlNSHf PRSH, DISH, NB AO) 

C  THIS  ROUTINE  TAKES  PROFILE  DATA  FROM  COMPR  AND  STORES  THEN 
C  IN  ARRAYS  X,  1  THROUGH  NRSETS,  FOR  AOJUSTNENT  BY  COLSAC 
5  C  THE  DATA  ARE  ALSO  SCALEO  USING  THE  SCALES  IN  ARGUNENT  LIST 

C  USES  SUBROUTINE  SHOCK  TO  CONFUTE  SHOCK  VALUES  AT  PROFILE  DISTANCE 
C 

LEVEL  2#X, R# ALAB, LSTX 

DINE  NS  ION  X<5,100),R<5,5,100)fALAB<2f 100), LSTX < 100) 

10  CONNON/CONPR/TPPRI 2,5000) ,ERTPPRC2,5000)»ALBPR<2,  5000) * 

1  NSETPR<50)»DISTPR<50 ),ERDIPR< 50) 

LEVEL  2,TPPRfERTPPR#ALBPR»NSETPR,DISTPR»ERDIPR 
NBAD-0 

NRSETS«NSETPR<NRCASE)  $  IF< NRS ETS .LE.O) GOTO  AS 
15  KIN-1  S  IF<NRCASE<EQ<DGOTO  25 

DO  15  KA-2, NRCASE 
15  KIN-KIN*NSETPR<KA— 1 ) 

25  KEN-KIN*NSETPR<NRCASE  )-l  S  KST-0 
C 

20  DO  35  KA-KIN,KEN 

KST-KST*1 

X< 1, K$T)-TPPR<1, KA)/$CTINE 
XI 2»KST)-TPPR<2, KA)/SCPRES 
R<l»lfKST)*<ERTPPR<l,KA)/SCTIHE)**2 
25  R<2, 2,KST ) -<ERTPPR  <2,  KA)/ SC PRES)  4*2 

R  <  1,  2, KST) -0  t  R  <2* 1*  KST)-0  S  LSTX(KST)«0 

ALAB< It KST ) -ALB PRC 1»KA)  $  ALAB <2» KST)-ALBPR <2» KA) 

35  CONTINUE 
C 

30  DS-DISTPR(NRCASE) 

CALL  SHOCK! DSf TS# PSOVf US# UPf RHOf NBADI 
IF<NBAD<NE<OIRETURN 

C  SHOCK  RESULTS  ARE  IN  SI  UNITS.  SCALE  THE  OUTPUT  ACCORDING  TO 
C  SCALES  IN  THE  ARGUNENT  LIST. 

35  TINSH-TS/SCTINE 

PRSH- PS OVf SC PRES 
OISH-OS/SCDIST 
RETURN 

45  NBAD-1  S  RETURN 
40  ENO 
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SUBROUTINE  FITPRCX,R* ALAB*LSTX»NRSET* TIMSH, PRSH, DISH, PAR* VP AR,ERZ 
A  TITLE*SCDIS»SCPRES»SCTINE,NBAD) 

C  THIS  FITS  THE  ONE  PRESSURE  HISTORY  WHICH  IS  STORED  IN  X 
C  THE  SUBROUTINE  IS  CALLEO  FRON  MAIN  AFTER  THE  DATA  HAVE  BEEN  PREPARED 
C  BY  CALLING  SCALPR 
C 

LEVEL  2,X, R, ALAB, LSTX,XC»C»LSTN» WORK 
COHMON/SCRCH/XC C 5*100 )*CC 5* 100)*LSTNf 100), WORK! 12560) 

C 

DIMENSION  PARC10), VPARC 10*10), ERPC10), VC  10*10)* TITLE (3) 

DIMENSION  XC5*100)*RC5*5* 100) *  ALAB(2»100)*LSTX(100) 

DIMENSION  PPRC10) 

C 

COMMON/PSTS/PS»TS 

C 

EXTERNAL  EXPON 
C 

NXD-5  $  NPD-10  *  NW-12560 

PS-PRSH 

TS-TIMSH 

C  STORE  SHOCK  OVERPRESSURE  AND  ARRIVAL  TIME  IN  COMMON  /PSTS/ 

C  COMMON  /PSTS/  IS  USED  BY  THE  CONSTRAINT  SUBROUTINE  EXPON 
CALL  GUESSC  X* PPR* NR SE T# TINSH* PRSH) 

C  GUESS  COMPUTES  INITIAL  ESTIMATES  OF  PRESSURE  PROFILE  PARAMETERS 
DO  15  KP-1,10 
15  PARCKP)-PPRCKP) 

NR-NRSET 

NX-2 

NP-3  S  ITYPE-0 
IFCNRSET.LT. 3)  GOTO  37 

C ALLCOLSAC ACX,R» ALAB, LSTX*NX, NR»PAR,NP» EXPON, ITYPE* XC»C» LSTN,NRGD» 
1  ERZ, VPAR, ERP,LBAD*NXD»NPO*  WQRK,NW) 

IF (L BAD.EO. 0)  GOTO  45 

C  SUBSEQUENT  CALLS  TO  COLSACA  ARE  EXECUTED  ONLY  IN  CASE  OF 
C  CONVERGENCE  PROBLEMS 
C 

DO  25  KP-1*10 
25  PARC  KP)-PPRCKP) 

NP-2  $  PARC  3)-0 
I  TYPE -4 

C ALLCOLSAC AC X,R* ALAB* LSTX*NX*NR*PAR*NP* EXPON* ITYPE* XC»C*LSTN*NRGD* 
1  ERZ* VPAR* ERP*L BAD* NXD*NPD*WORK*NW) 

NP-3 

ITYPE-1 

C ALLCOLSAC A CX*R* ALAB* LSTX,NX, NR*PAR*NP* EXPON, IT YPE*XC*C*LSTN,NRGO* 
1  ERZ* VPAR* ERP*L8AO*NXO*NPD*WORK*NW) 

IFCLBAD.EQ.O)  GOTO  45 
ITYPE-4 
DO  35  KP-1* 10 
35  PARCKP)-PPRCKP) 

37  C  ALLCOLSAC AC X*R*ALAB*LSTX*NX*NR*PAR*NP*EXPQN*ITYPE*  XC»C*LSTN*NRGO* 

1  ERZ* VPAR* ERP»LB AO*NXO*NPD* WORK* NW) 

IFCLB AD.EQ.25)  ITYPE-1 
IFCLBAD.EQ.25) 

AC ALLCOLSAC AC X,R, ALAB* LSTX*NX*NR*P AR,NP* EXPON* ITYPE, XC*C,LSTN,NRGD, 
1  ERZ* VPAR* ERP*LB AO* NXO*NPD* WORK* NW) 

C 
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C  NEXT  PRINT  THE  RESULTS  OF  FITTING 

*5  CALL  PR TPNTS(X*R*ALA8»XC»C*NRSET*TIHSH*PRSH»DISH» TITLE* 
A  SCDIS*SCPRES*SCTIME) 

NBAO-LBAO 

RETURN 

ENO 


1 


SUBROUTINE  GUESS ( X* P AR *NR» TS> PS  I 
C  THIS  ESTABLISHES  INITIAL  APPROXIMATIONS  OF  PAR 
C  X  -  TINE  AND  OVERPRESSURE 

C  PAR  -  MODEL  PARAMETERS  A»B»C  IN  THE  MOPEL 
5  C  P— C*(PS+CI*EXP{A*TAU+B*TAU**2»# 

C  TAU-T-TS.  PAR  IS  OUTPUT  FOR  THIS  ROUTINE 

C  NR  -  NUN8ER  OF  DATA  POINTS 
C  PS#TS  •  SHOCK  OVERPRESSURE  AND  ARRIVAL  TIME 

10  DIMENSION  X(5#100)*PAR(10) 

LEVEL  2#X 

COMNON/GUE  CM/AN(3#3I*RS(3)*W(18) 

OOUBLE  PRECISION  AN»RS*W»DET 
15  LEVEL  2» AN#  RS»W 

IFCNR.GT. 3IG0T0  25 
PRINT  15#  NR 
RETURN 

20  15  FORM ATI 1H 0*40(1 H*l»/# 1H  > 10X# 12HERR0R  RETURN# 

A35H  FROM  SUBROUTINE  GUESS  BECAUSE  NR  -,I3* 

B28H  IS  TOO  SMALL  FOR  ADJUSTMENT* /» 1H0»40( 1H* ) I 

25  PMIN-PS 

25  DO  35  KA- 1#  NR 

P MIN« AMIN 1(PMIN»X(2#KAI) 

35  CONTINUE 

C  THIS  ESTABLISHED  LOWEST  VALUE  OF  OVERPRESSURE 

30  CMIN— PS*0.5 

CNAX-AMIN1(0.#PMIN-PS*0.05> 

C-CMAX 

C  INITIAL  GUESS  FOR  PARAMETER  C 
IFICMIN.LT. CMAXIGOTO  55 
35  PRINT  A 5#  PS»PMIN 

RETURN 

45  FORMAT C 1H 0*40(1 H*)#/# 1H  * 10X* 17HERR0R  RETURN  FROM* 

A3 OH  SUBROUTINE  GUESS  BECAUSE  PS  -*1PE12.5* 

B12H  ANO  PMIN  ■  * 1PE12 .5# /, IH  *40(1H«)) 

40 

55  KIT-0 

C  KIT  IS  ITERATION  COUNTER 
NX-3  S  NA-3  $  KIN-1 

C  NEXT  ESTABLISH  NORMAL  EOS  FOR  SIMPLIFIED  PROBLEM 
45 

56  DO  75  K A- 1*  3S  DO  65  KB«1»3 
65  AN(KA»KB) -0 

75  RSIKAI-0 

50  DO  85  KA«1,NR 

T  AU-X( 1»KA1-TS 

RQ-(PS-X(2»KA1)/((PS-C>*(X(2»KA)-CI » 

AL«AL0G((X(2,KAJ-C l/IPS-C  ») 

WE«( X(2,KA1-C)**2 

55  AN(l#ll«AN(l»mWE*TAU**2  S  AN(1#2)*AN(1#2) ♦WE*TAU**3 

AN(1»3I-AN(1,3)+WE*R0*TAU  %  AN(2»2)-AN( 2,21 *W£*TAU**4 

AN(2*  3>-AN(2*3M-WE*R0*TAU**2  $  AN  (3*  3  >»AN  (  3*  3  )  *WE*RO 


Ul 


RS<1)-RS(1I*UE*TAU*AL 
RS (2 ) -RSI  2 1 ♦WE*TAU**2*AL 
RSI3)-RSI3)4WE*R0*AL 
85  CONTINUE 

ANI2*1)-ANI1»2)  S  AN(  3»1)-ANI1»3)  $  AN(3,2)-ANf 2,3) 

CALL  HTRINOBI AN»NX»RS»NA»KIN»DET»W) 

C  THIS  SOLVEO  THE  NORNAL  EQUATIONS 

IFINX.EQ.2.0R.DET.NE.0.)  60T0  95 
NX-2  $  NA-3  $  KIN-1 
GOTO  56 
95  CONTINUE 

EPS-RSI3)  $  IF  I NX. E 0*2)  EPS-0. 
C-AHAXllCNIN,AHINltC«-EPSf  CHAX)  I 
KIT-KIT^l 

NX-3  *  NA-3  $  KIN-1 
IFIK1T.LT. A)  GOTO  56 
C  ITERATE  THREE  TINES 

PARI  1  )>RS(  1)  $  PARI 2)  -RS (  2)  t  PARIS)— C 
RETURN 
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SUBROUTINE  EXPON  C X* K A* P AR* F» FX» FP»FXX* F XP» F PP*  NB  AD ) 
CONSTRAINT  FOR  3-PARANETER  PRESSURE  HISTORY  FITTING  BY  FITPR 
F  »  CPS*CI*EXPCA*TAUAB*TAU**2)-C-P»  TAU-T-TS 
T-XC1I  $  P-XC2I 

LEVEL  2*X»FX#FP»FXX*FXP»FPP 

DIMENSION  X(5»100>»PARC10)»FXCS)*FPC10)»FXXC5»5),FXPC5»10) 
1  FPP ( 10*10 1 
CQMNON/PSTS/  PS»TS 

NBAD-0 

A*PAR(1I»2.*PAR(2>*(X(1»KAI-TS) 

B-XC 1»KAI-TS 
ARG- CPARC2)*B*PARC1I)*B 
IFIARG.LT, 700.)  GOTO  15 
NBA0-1  t  RETURN 
15  IFCARG.LT. -650.1  EXPQ-O. 

IF  CARG.GE.-650. )EXPQ-EXPC ARG) 

C  THIS  AVOIDS  OVERFLOW  OR  UNDERFLOW  IN  THE  EXP  ROUTINE 
PC«PS*PARC3) 

PEX-PC*EXPQ 

F-PE X— PARC  3)— XC2»KA) 

FXC1I-APPEX 
FXC2 ) ■— 1. 

FPC1 I -B*PEX 
FPC2)»B**2*PEX 
FPC3 I ■EXPO— 1. 

C  SECOND  DERIVATIVES 

FXXC1*11-PEX*C2.*PARC2)*A*«2I 

FXXC 1*2)*0.0 

FXXC2, 11-0.0 

FXXC2, 2)«0.0 

FXPC  1,1  l«PEX*U.*8PA> 

FXPC  2,11-0.0 

FXPC  1,2  >-PEXM2.*B*B**2*A> 

FXPC2, 21-0.0 
FXPC 1»3)*EXPQPA 
FXPC  2*31-0.0 
FPPC 1,1)-PEX*B**2 
FPPC1,2)»PEX*BP*3 
FPPC 2*1) -FPPC 1*21 

FPPC 1* 31-EXPQPB  %  FPP(3»1)-FPPC1*3) 

FPPC2,2)-PEXPB*PA 

FPPC2,3I-FPPC1,3)*B  $  FPP C 3* 2 )«FPPC2* 3) 

FPPC  3»3)-0 
RETURN 


SUBROUTINE  PRTPNTS(X*R*ALAB*XC*C*NR*TS*PS*DS*TITLE* 

A  SCO I S*SCPRES* SCTIME) 

C  THIS  IS  CALLEO  FROM  FITPR  TO  PRINT  THE  SINGLE  HISTORY 
C  ADJUSTMENT  RESULTS 
C 

DIMENSION  X(5»100)*R(5*5,100)*ALAB(2*100)*XC(5»100) 

DIMENSION  CI5, 1001, TITLE! 3» 

LEVEL  2»X» R» ALAB*XC*C 

NSI-1 

HTXD-3HM  $  HTXP-3HPA  S  HTXT»3HS 
TXT-5H  IS)  *  TXP«5HIP A) 

IFISCDIS. EQ.l.. AND. SCPRES.EQ.l.. AND. SCTIME. EQ.l.)  GOTO  5 
NSI»0 

C  NS  1*0  INDICATES  THAT  COMPUTATION  IS  NOT  IN  SI  UNITS 
HTXD-3HSCD  $  HTXP-3HSCP  %  HTXT-3HSCT 
TXT-5HISCTI  S  TXP-5HISCP) 

5  DO  100  J-1,NR 

IFIMOD! J,40).NE.1I  goto  45 

PRINT  10»ITITLEIK)»K«1»3)»DS»HTXD»PS»HTXP»T$»HTXT 
10  FORMAT I1H1*5X*5HEVENT»5X*  3A10*  ASX*  21HHIS  TOR Y  DISTANCE  •  * 

A  1PE10.3,  2X,A3,/»1H  * 5X*5I1H-)*80X* 21HSH0CK  OVERPRESSURE  •  * 

B  1PE10.3,  2X»A3»/»1H  * 90X* 21HSH0CK  ARRIVAL  TINE  •  * 

C  1PE  1 0. 3*  2  X*  A3*  /  I 
PRINT  20 

20  FORMAT ( 1H  • 24X,  43HADJ  USTNENT  OF  A  SINGLE  OVERPRESSURE  HISTORY* / ) 
PRINT  30*  TXT* TXT# TXT* TXT »TXP»TXP*TXP*TXP 
30  FORMAT  1 1H  » 8X.6HLABEL S»14X,4HTIHE,7X,9HSTD. ERROR, 3X, 

A  10HC0RRECT ION, 4X*9HC0RR. TIME* 2X, 12H0VERPRESSURE*  3X* 

B  9HSTD. ERROR, 3X, lOHCORRECTjON* 4X* 10HC0RR.0VPR . * /* 

C  1H  *22X*8I6X*A5*2XI* / 1 
AO  FORMAT I  1H  I 

45  R1«S0RT(R(1,1*JM 
R2"SQRT(R(2,2*JI ) 

PRINT  50*  ALABI1*J)*ALABI2*J)*XI1*JI*R1*CI1*J)*XCI1*J)»XI2*J)* 
1  R2,CC2»J ),XC!2* J) 

50  FORMAT! 1H  , 2X,2 A10, IP, 8! 3X, E10 .31) 

75  IFII J/5)*5.EQ.J)  PRINT  40 

I  F(  J  .  NE  .NR.  AND.  MODI  J*  40).  NE  •  0.  IGOTO  100 
IF(NSI.EQ.l)  GOTO  100 

C  PRINT  SCALES  IF  SI-SCALES  WERE  NOT  USED 
PRINT  115*SCDIS*SCPRES*SCTIME 

115  FORMAT ( 1H  ,/,lH  *21X*31HTHE  DATA  ARE  SCALED  AS  F0LL0WSt*5X* 

A  16HDISTANCE  SCO  ■  *1PE12.5*3H  M,/,1H  ,57 X* 

B  16HPRESSURE  SCP  ■  *1PE12.5*4H  PA*/*1H  *57X* 

C  16HTIME  SCT  •  *1PE12.5*3H  S> 

100  CONTINUE 

IF(M00INR*40).GT.30)  PRINT  55 
55  FORMAT! 1H II 
RETURN 
END 


SUBROUTINE  DIMPAR! SCDIS* SCPRES»SCTIME»P* VP* ERZ* PDIM, VPDIM) 

C  THIS  COMPUTES  OIMENSI ONAL  VALUES  OF  PRESSURE  PROFILE  PARAMETERS 
C  IT  IS  CALLEO  FROM  MAIN  AFTER  A  PROFILE  ADJUSTMANT  BY  FITPR 
C 

DIMENSION  P!10)*VPfl0»10)*PDIM!10)*VP0IM!10»10) 

DIMENSION  SCMAT 110*10) 

DO  15  KA>1»10  $  DO  15  KB«1,10 

15  SCMAT  IKA*KB)*0 

SCMAT! 1,1)«1. /SCTIME  S  SCMAT !2* 2) »1./ SCT IME**2 
SCMAT! 3*3 )• SC PRES 
C 

DO  45  KA-1,3  $  PDIMIKAI-0 

00  35  KB-1>3  *  VPOI MIKA*KB ) *0 

DO  25  KC* 1»  3  %  DO  25  KD*1*3 

25  VPDI N!  KA» KB )«VPD IN! KA  *KB ) ♦SCMATIKA* KC )*VP 1KC»KD>*SCMAT!KB»KD) 

35  PDIMIKA)-POIM!KA)+SCHAT!KA»KB)*PiKB) 

45  CONTINUE 

C 

PRINT  55 

55  FORMAT! 1H0* ///» 1H  * 10X, 32HDIMENSI0NAL  VALUES  OF  PARAMETERS*/) 
PRINT  65 

65  FORMAT! 1H0, 10X, 10HP AR AMETER S * 5 X,8HS TAND ARO* 7X» 8HSTAN0AR0, 

A  5X* 9HD IN ENSIGN* /» 1H  * 26X* 6HE R RORS* 7X* 1 OHERRORS* ERZ, / I 
PER-SQRT! VPOIMU,!))  $  PERZ-PER*ERZ 
PRINT  75*PDIMI1)* PER*  PERZ 

75  FORMAT  1 1H  , 9X,1 PE12.5, 3X, IP  El 0.3,4X» 1PE10. 3* 6X» 3H1/S ) 
PER*SQRT!VPDIM!2»2))  S  PERZ*PER*ERZ 
PRINT  85*P0IM!2)*PER»PERZ 

85  FORMAT! 1H  , 9X,1PE12.5* 3X, 1PE10.3, 4X,1PE10.3,6X,6H1/S*P2 ) 

PER«SQRT!VP0IM!3,3))  *  PERZ*PER«-ERZ 
PRINT  95,P0IM!3),PER*PERZ 

95  FORMAT  1 1H  * 9X*1PE12.5» 3X, 1PE10.3* 4X, 1PE10.3, 6X, 2HPA) 

PRINT  105 

105  FORMAT 1 1H  ,////, 1H  *20X*24HTHE  OVERPRESSURE  HISTORY* 

A  19H  IS  APPROXIMATED  BY*///* 

8  1H  *  30X*  7HP!  Tl  •  ,35H-C  ♦  !PSHOCK*C)*EXPI  AMT-TSHOCK)  ♦  , 

C  19H  B* !T-T SHOCK )**2  ),*//, 

0  1H  >  30X*  42HWHERE  A*  B  AND  C  ARE  THE  THREE  PARAMETERS.) 


RETURN 

ENO 


SUBROUTINE  PLTPNTS  <  X,  R,  AL  AB,  NR  ,  PSH,  TSH,  SCP,  SC  T  ,  P  AP,  V,  T  I  TL  E  ) 

C  THIS  ROUTINE  PLOTS  FITTED  PRESSURE  HISTORY  AND  CORRESPONDING  OBSERVAT 
C  THE  PLOTTING  IS  OONE  IN  SI  UNITS 

C  X(5,NR>  »  TIME  XU,  )  AND  PRESSURE  X<2,  )  OBSERVED 

C  R(5,5,NRJ  *  VARIANCE-COVARIANCE  MATRIX  OF  OBSERVATIONS  X 

C  AL  A3  <  2, NR )  *  LABELS  OF  OBSERVATIONS 

C  NR  *  NUMBER  OF  OBSERVATIKNS 

C  PSH  -  SHOCK  OVERPRESSURE  AT  HISTORY  GAGE  LOCATION 

C  TSH  *  SHOCK  ARRIVAL  TIME  AT  HISTORY  GAGE  LOCATION 

C  SCP,  SCT  -  PRESSURE  ANO  TIME  SCALES,  RESPECTIVELY,  OF  THE  ABOVE 

C  PARI  10)  *  HISTORY  FITTING  PARAMETERS  IN  SI  UNITS 

C  V( 10,10)  •  VARIANCE-COVARIANCE  MATRIX  OF  PAR 

C  TITLEC3)  -  NAME  OF  THE  EVENT 

C 

DIMENSION  X ( 5,100 ) »  R( 5, 5,100), PAR (101, VI 10, 10 », ALABI2, 100) 

DIMENSION  Q  ( 2,2  ) 

DIMENSION  TEMPI  8),  TIT  LEO),  XI  (200 1,  Y1(200),Y2(  2  00) 

DIMENSION  X3(201 ), Y3( 201 ) » X4( 201 > , Y4(  201 > 

LEVEL  2,FX,FP,FXX,FXP,FPP 

C  OMMON/ SCRCHA/XP (5,1) ,FX(5),FP(10),FXX(5,5),FXP( 5»10)»FPP(10»10! 

COMMON/PSTS/PS,TS 

LEVEL  2,X , R, ALAB, XP 

COMM ON/ PLOT/ERF, 0(5), PLABL(A) 

C 

PS-PSH*SCP 

TS«TSH*SCT 

XMIN«X( 1, 1)*SCT  S  XMAX-XMIN 
DO  15  KA-2»NR 

XM  IN  "AM  INK  XMIN,  X(1»KA)*SCT) 

XMAX"AMAX1(XMAX,X(1,KA)*SCT) 

15  CONTINUE 

OELX-( XMAX-XMIN)/ 200. 

IF(ERF.EQ.O.O)  ERF-2.0 
C 

C  NEXT  COMPUTE  200  POINTS  OF  FITTEO  CURVE  WITH  CONFIDENCE  LIMITS 
DO  200  I" 1, 200 
ES-0.0 

XP(1,1)-XMIN*0ELX*I 
XP (2, 1 ) *0.0 

CALL  EXPQN(XP,1,PAR,F,FX,FP,FXX,FXP,FPP,NBAD) 

C  F  IS  OVERPRESSURE 

IF(NBAO.EQ.O)  GOTO  139 
PRINT  134*NBAD 

PRINT  135,XP(1,1),(PAR(J),J>1,5) 

PRINT  138 
RETURN 

134  FORM  AT ( 1H  ,10X,*ERR0R  RETURN  FROM  EXPON  WITH  NBA0«*,I5> 

135  FORMAT ( 1H  ,10X,*THE  ARGUMENTS  WERE  XP( l , 1 ) »♦, 1PE 12. 5, / 

A  1H  , 10X»*PAR(J )  -  *» 5( 2X,1PE12. 5) ) 

138  FORMATdH  ,10X,*ERR0R  RETURN  FROM  PLTPNTS*) 

139  DO  150  KA* 1 , 3 
DO  150  KB* 1,3 

ES«ES*FP(KA)*V(KA,KB)*FP(KB ) 

150  CONTINUE 
E-SQRT(ES) 

C  E  IS  THE  STANDARD  ERRROR  OF  COMPUTEO  F  (OVERPRESSURE) 


c 

xi<n-xp(i*n 

60  Y1(I ) -F*ERF*E 

Y2(I l«F-ERF*E 
X3(I*1)-XP(1,1) 

Y3(I«>1)-F 
200  CONTINUE 

65  CALL  PLTBEG(8.7,11.2,1.0, 13,PLABL) 

C 

C  NEXT  FIX  SCALES  AND  PLOT  AXES  WITH  LABELS 
C 

XSIZE-5.0 

70  YSIZE-4.0 

X3(1)«X3(2) 

CALL  FI XSC A(X1,  200, XSIZE,XS,XMIN,XHAX,OX) 

CALL  FIXSCA(Y1,200,YSIZE,YS,YHIN,YHAX»DY) 

CALL  C0NSCA(Y2,200,YSIZE, YS, YNIN, YHAX,DY) 

75  0(1,1)>R(1,1,1)*SCT**2 

Q(l»2)-R( 1,2,1)* SC T*SCP  S  Q( 2, 1 )-Q( 1, 2) 
Q(2»2)»R(2,2»1)*$CP**2 

CALL  ERELCM(X(1,1)*SCT,X(2,1)*SCP»Q»ERF,X4,Y4) 

CALL  CONS CA(X4, 201, XS IZE, XS» XHIN, XNAX, DX) 

80  CALL  CONSC A( V4» 201,YSIZE,YS,YNIN, YHAX,DY) 

0(1, 1 )-R( 1, 1,NR)*SCT**2 

Q(1,2)-R(1,2,NR)*SCT*SCP  $  0(2,11-0(1,21 

0(2, 2)-R(2»2,NRI*SCP**2 

CALL  ERELCH(X(l,NR)*SCT,X(2,NR)*SCP,Q,ERF,X4,r4) 

85  CALL  CONSCA(X4,201,XSIZE,XS,XHIN,XNAX,DX) 

CALL  CONS  C A ( Y4» 201,YSIZE,YS,YNIN,YNAX,DY) 

Y3(l ) -YHIN 

CALL  PLTSCA(2. 5,4. 0,XHIN, YHIN, XS,YS) 

CALL  PLTAXS ( OX, DY, XHIN, XNAX, YHIN, YN AX, 4} 

SO  CALL  LA8AX(0X»2«0*DY,  XHIN, XNAX, YHIN, YNAX) 

HT-0.1 

ENCOOE ( 80, 160, TEMP)  ERF 
160  FORNAT(*FITTED  CURVE  WITH  *,F3.1,*  STANDARD  ERRORS>*) 
TX«(XHAX*XHIN)*0.5-17.5*HT*XS 
95  TY-YHAX*0.5*YS 

CALL  PLTSYN(HT,TENP,0.0,TX,TY) 

ENCODE! BO, 110, TEMPI 
110  FORNAT (9HTIHE  (S)>) 

TX-(XMAX*XHIN)*0. 5—4*  0*HT*XS 
100  TY-YNIN— 0»5*YS 

CALL  PLTSYM(HT,TENP,0.0,TX,TY) 

ENCOOE ( 80, 120, TEMP ) 

120  FORMAT! 18H0VERPRESSURE  (PA>>> 

TX-XNIN-0.74XS 

105  TY-( YNAX+  YHIN)*0, 5-9, 0*HT*YS 

CALL  PL  TSYHIHT,  TEMP, 90.0,  TX,TY) 

C 

C  NEXT  PLOT  CURVE  WITH  CONFIDENCE  LIMITS 
C 

110  CALL  PLTDTS(1,0»X1,Y1, 200,0) 

CALL  PLTDTS(1,0,X1,Y2, 200,0) 

CALL  PLTDTS(1,0,X3,Y3, 201,0) 

C 

C  NEXT  PLOT  ERROR  ELLIPSES  OF  OBSERVATIONS 
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00  250  1“ 1 » NR 

xim-xu»n*scT 

Y1(I)«X(2»I)*SCP 

QCl»l»«RCl»l,n*SCT**2 

0(1»  2  >  *  R ( If  2» I)*SCT*SCP  J  Q ( 2» 1 )* Q( 1»  2  > 

Q(2,2)«R(2,2,I)*SCP**2 

CALL  ERELCMCXim»n<  I) , Q»ERF, X3> Y3 > 

CALL  PLTDTS(1»0»X3»Y3*201»0) 

250  CONTINUE 

C  THIS  PLOTS  OBSERVATIONS 

CALL  PLT0TS(3#1»X1»Y1»NR»0) 

ENCODE ( 80»130»TENP)  ALAB (1>1) 

130  FORMAT! A10»1H>) 

TX-!  XMAX«-XNIN)*0.5-5.0PHT*XS 
TY«YMAX»0.75*YS 

CALL  PLTSYM!HT»TEMP.O.O»TX,TY» 

ENCODE! 80, 140, TEMPI  TITLE 
140  FORMAT i 3A 10* 1H> ) 

TX«!  XMAX+-XMIN)*0.  5-15. 0*HT*XS 
TY*YNAX*0.95*YS 

CALL  PLTSYM!HT»TEMP»0«0»TX*TY) 

CALL  PLTPGE 
RETURN 
END 
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SUBROUTINE  PRINPAR ( PL AB# 0 IS T#  T IN, PIN# P, VP# DISTD, 

A  TIMD»PIND#PD#VPD#NR# PNU»EXNU» TITLE) 

C  SUBROUTINE  PRINTS  SUMMARY  OF  PRESSURE  HISTORY  FITTINGS 
C  IT  IS  CALLED  FROM  MAIN  AFTER  ALL  PRESSURE  HISTORIES  HAVE  BEEN  FITTED 
5  C  IT  ALSO  COMPUTES  INITIAL  PARAMETER  APPROXIMATIONS  PNU  AND  EXPONENTS 

C  EXNU  FOR  THE  PRESSURE  FIELD  FUNCTION 
C 

DIMENSION  PLAB(50),DIST<50)#TIMC50)»PIN( 50)#P<4,  50 )  ,  VP ( 4, 4, 50) . 

AD  I  STD (50) #TIMD<50),PIND(50)#PD(4,50)#VPD<4, 4»50>»ER< A) 

10  8#PNU(10)#EXNU(3)#TITLE(3) 

LEVEL  2#P#VP#PD#VP D 

PRINT  12#(TITLE('))#J*1»3) 

FORMAT  C 1HI#  /# 1H  , 10X» 5HEVENT# 5X#3A10» /# 1H  #10X#5(1H-)) 

PRINT  15  $  PRINT  25 

FORMAT ( 1H  #///#lH  # 10X#20HSC AL  ED  PARAMETERS  OF# 

A30H  INDIVIDUAL  PRESSURE  HISTORIES#/) 

25  FORM  AT ( 1H  # 3X»3HNR. » 5X» 5HLABEL# 6X»8HDIS TANCE# 2X , 

A  12HARR IVAL  TIME# 1X.9H0VERPRES .» 5X» 6HPAR( 1 )# 3X, 9HSTD. ERROR# 

B  5X»  6HP AR ( 2 )» 3X, 9HSTD • ERROR#  5X»6HPAR( 3)»3X»9HST0. ERROR# /) 

PRINT  16 

FORMAT ( 1H*#  23X»5H(SCD)»6X»5H(SCT)#8X, 5H ( SC P ) # 

A  6X»7H(1/SCT)»4X#7H(1/SCT)»4X#10H(1/SCT**2)»1X» 

B  10H( 1/SCT**2)#5X#5H(SCP)#5X#5H(SCP )#/) 

DO  65  KA*  1# NR 
DO  55  KB*1»3 

55  ER(KB)*SQRT(VP(KB#KB*KA)) 

30  PRINT  35#KA*  PLAB ( KA)#DIST(KA)#TIM(KA)#PIN(KA)# 

A  ((P(J#KA)  ,ER(J) )>J*1#3) 

65  CONTINUE 

PRINT  A 5  t  PRINT  25 

35  A5  FORMAT ( 1H  »///>lH  # 10X»25H0 IMENSIONAL  PARAMETERS  OF, 

A30H  INDIVIDUAL  PRESSURE  HISTORIES#/) 

PRINT  A6 

A6  FORMAT (1H*,24X#3H(N)»8X#3H(S)#9X#4H(PA)#8X#5H(1/S)» 

A  6X#5H( 1/S)#6X,8H(1/S**2)#3X,8H(1/S**2)#6X#AH<PA)« 

AO  B  6X»  AH(PA)#/) 

DO  85  KA*1#NR 
DO  75  KB» 1#  3 

75  ER(KB)«SQRT(VPO(KB#KB#KA) ) 

A5  PRINT  35#KA#PLAB(KA)#DISTD(KA)#TIMD(KA)#PIND(KA)# 

A  ( iP0(J*KA)#ER(J ) ) #  J ■ 1#  3 ) 

35  FORMAT! 1H  » 2X#IA, 2X# A10# 3(2X# 1PE10. 3) #3 ( 2X# 1PE 1 1. A# IX# 1PE9 . 2 ) ) 

85  CONTINUE 
C 

50  C  NEXT  COMPUTE  INITIAL  APPROXIMATIONS  OF  PRESSURE  FIELD  PARAMETERS 

C  AND  EXPONENTS  FOR  THE  PRESSURE  FIELD  FUNCTION 
C  BY  STRAIGHT  LINE  LG#LG  FIT  OF  P AR AMETE R( DI ST ANCE ) 

C 

00  135  KB-1#3 

55  Cll-0  *  C 12*0  $  C22-0  *  RS1-0  %  RS2-0 

KK»0 

DO  105  KC ■1#NR 


\20 


IMDIST(KC).lE.O.)  GOTO  105 
IF(ABS<P<KB*KC>).LT.l<E-30)  GOTO  105 
KK-KK*1 

IF<KK<EQ<D  KM-KC 
IF(DIST<KC)  .LT.DISTIKMM  KM-KC 
ALD- ALOGC  01 ST IKC I 1 

PSQ*P<KB»KC )**2  $  ALP-O. 5*AL0G<PSQ) 

C 11-C 11+PSQ  $  C12-C12*PSQ*ALD  $  C 22-C22»PSQ*ALD**2 
RS1«RSDPSQ*ALP  »  RS2-RS2+PSQ*ALP*ALD 
SIG-SIGN<1.*P<KB*KM>> 

C  USE  THE  SIGN  OF  PARAMETER  CORRESPONDING  TO  SMALLEST  OISTANCE 
105  CONTINUE 

I F (KK  <GE. 2 )  GOTO  125 

PRINT  115*  KB 

STOP 

115  FORMAT ( 1H  *//,lH  »10X*15HST0P  BY  PRINPAR* 

A  37H  BECAUSE  LESS  THAN  TWO  HISTORIES  HAVE*/* 

B  1H  * 10X* 19HN0N-ZER0  PARAMETER!*  II* 1H ) ) 

125  C-(RS1*C22-RS2*C12 )/( C11*C22-C12*P2) 

EN-(RS2*C11-RS1*C12)/(C11*C22-C12P*2I 
PNU< 2*KB-1)-EXP(C )*SIG 
PNU(  2*KBI  -0. 

N  EN-  EN*10  .  $  EXNUCKB)— FLOAT  (NENI/10. 

135  CONTINUE 

PNU( 5)-— PNUC5I 
PRINT  1*5 

1*5  FORMATCIH  ,////. 1H  »10X»22H INITIAL  APPROXIMATIONS* 

A  36H  OF  SCALED  PRESSURE  FIELD  PARAMETERS*//) 

DO  165  KB«1»3 
KC-2*KB— 1  S  KD-2PKB 

PRINT  155* KC*PNU(KC )»KO»PNU(KD  )» KB* EXNU (KB ) 

155  FORMATCIH  , 10X, *HPNU< » II* 2H > 1PE12 . 5, 5X, *HPNUI *  II* 2H) 1PEB. 1 
A  5X*5HEXNU(*I1»2H)-*0PF5.2) 

165  CONTINUE 
RETURN 


SUBROUTINE  PLTPARINRPROF, PRPD* PRDSD* TITLE) 

C  THIS  ROUTINE  PLOTS  HISTORY  PARAMETERS  VERSUS  DISTANCE  IN  LOG-SCALES 
C 

C  NR  PROF  «  NUMBER  OF  HISTORIES  OBSERVED 

C  PRPDI4,  50)  «  HISTORY  PARAMETERS 
C  PROS 015  0)  -  HISTORY  DISTANCES 

C  TITLEI3)  -  DESIGNATION  OF  EVENT 
C 

LEVEL  2*PRPD 

DIMENSION  PRPD!4»50)»PRDSD!50) 

DIMENSION  T ITLE C  3 1 
DIMENSION  X!50)»YI50I»TEMP<41 
DIMENSION  XA!50),NSI50I,DIH!3I 
C0NM0N/PLQT/DI6)*PLABLi4l 
C 

DIMm«10HIl/S)> 

DIM! 21«10H!1/S**2>> 

OIMI 3I«10H1PA>> 

CALL  PLTBEG18.7, 11.2* 1.0, 13,PL ABL ) 

DO  1000  KA*1,3 
DO  100  KB«1,NRPR0F 
X1KBI-AL0G101PRDSDIKB I ) 

Y!KB)«AL0G10! ABS ! PRPD  IKA, KB  II ) 

X A (K  B ) » X( KB  ) 

NS (K  B ) »0 

IF!PRPO!KA,KBI.LT.O.OI  NSIKBI-1 

C  USE  SYMBOL  NS-0  OR  1  FOR  POSITIVE  OR  NEGATIVE  PARAMETERS*  RESPECTIVELY 
100  CONTINUE 
C 

CALL  SORTX  Y  (  X*Y»  NRPRQJF  ) 

CALL  SORTXY!XA*NS»NRPk0FI 

CALL  FLOGSC !X*NRPR0F*4.0*XS*XMIN* XMAX*OX) 

CALL  FL0GSC<Y,NRPR0F»6.0,YS»YMIN»YMAX,DY) 

XS«AMAX1!XS,YS1 

YS-XS 

CALL  PLTSCA!3.0,4.0,XMIN,YMIN,XS»YS> 

CALL  PLTAXS!OX,OY»XMIN»XMAX» YMIN* YMAX»7) 

CALL  LABL0G(DX*DY*XMIN*XMAX*YMIN*YMAX*0.0*0.0) 

CALL  PLTDTS(1»0,X,Y,NRPR0F,0I 
DO  120  KB-1,NRPR0F 

CALL  PLTDTS!3*NS!KB),  X (KB ), Y!K B I* 1, 0) 

120  CONTINUE 

ENCQOEI 40* 150*TEMP) 

150  FORMAT ( *D I  STANCE  <  M I »*  * 

TX«! XMIN*XM AX I *0.5-6. 0*0. 1*XS 
TY*Y MIN—O. 5*YS 

CALL  PLTSYM<0.1,TEMP»0.0,TX,TY> 

ENCODE! 40* 160*TEMP>KA,DIM!KAI 
160  FORM AT! *P ARAM ETER!*»I1»*I  *,A10> 

TX«XMIN-0.7*XS 

TY«! YMIN* YM AX  1*0. 5-9. 0*0.1* YS 
CALL  PLTSYMIO.l#  TEMP*  90.0»TX*TY) 

900  ENC00EI40* 370, TEMPI  TITLE 
370  FORMAT! 3A10*1H>) 

TX-! XMAX+XM IN  1*0. 5— 15 . 0*0. 1*XS 
TY«YMAX*0.5*YS 

CALL  PLTSYMIO.l, TEMP, 0.0,TX*TY> 
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SUBROUTINE  FTPFLO(SCDIS,SCPRE,  SCTIM, TITLE, PRLAB.PRDSD, 

A  TARD*PINO»NRPROF»EXNU»PAR»VPAR»ERZ»NP»NBAD) 

CALLED  FROM  MAIN  THIS  FITS  AN  OVERPRESSURE  FIELD  MODEL  TO  ALL 
OVERPRESSURE  DATA 

INITIAL  VALUES  OF  PARAMETERS  PAR  ARE  ASSUMED  TO  BE  SPECIFIED  BY 
THE  CALLING  PROGRAM 

SCDIS»SCPRE, SCTIM  «  SCALES  USED  FOR  THE  PARAMETERS 
TITLE  •  ALPHANUMERIC  TITLE  OF  THIS  RUN 
PRLAB  -  ALPHANUMERIC  LABELS  OF  HISTORIES 
PROSO  *  DISTANCES  OF  HISTORIES  IN  METRES 
TARD  «  SHOCK  ARRIVAL  TIMES  IN  SECONDS 
PINO  «  INCIDENTAL  SHOCK  OVERPRESSURES  IN  PASCALS 
NR  PROF  -  NUMBER  OF  PROFILES  (HISTORIES! 

EXNU  -  EXPONENTS  IN  OVERPRESSURE  MODEL  FUNCTION 

THE  FOLLOWING  WILL  BE  COMPUTED  BY  THIS  ROUTINE 

PAR  *  PARAMETERS  OF  THE  OVERPRESSURE  FIELO  MODEL 
VPAR  •  VARIANCE-COVARIANCE  MATRIX  OF  PAR,  NOT  INCLUDING  ERZ**2 
ERZ  «  STANDARD  ERROR  OF  WEIGHT  ONE 

NP  -  NUMBER  OF  OVERPRESSURE  FIELD  FUNCTION  PARAMETERS. 

NP.NE.5  ONLY  IN  CASE  OF  ERROR  RETURN 

DIMENSION  TITLE(3)*TAR0(50),PIN0(50)*EXNU(3),PAR(10),VPAR<10,10> 

DIMENSION  PST(6),VPF{10,10),ERPAR(10)»PARG(10> 

C 

EXTERNAL  PFIELO*PFIELDC,PLOAUX 
C 

C OMMON/COMPR/TP ( 2» 5000 )»ERTP(2» 50001* ALB (2» 5000), NS ET( 50 J, 

1  0IST(50),ER0IST(50) 

LEVEL 2*  TP»ERTP»ALB»NSET#DIST»ERDIST 
COMMON /CFLDEX/E  XA*  EXB,  EXC 
C  OMMON/CSC ALE/SCOI, SC  PR*  SC T I 

COMMON/ SC RCH2/  X( 3*5000! , R( 3* 3, 5000!*LSTX( 5000) , XC ( 3, 5000) , 

1  C(3*  5000) • WORK ( 14307 ),LSTN( 5000) 

LEVEL  2»X*R*LSTX*XC*C» WORK* L ST N 
C 

COMMON /TP INOX/ITC, I PC 
C  TIME  AND  PRESSURE  INDEX  IN  X-ARRAY 
DATA  (IT-2)*(IP»1) 

ITC* IT  *  IPC-IP 

C  X ( IT ) »T IME  *  X( IP ) »OVER PRES SURE*  X(3)-DISTANCE 
C 

SCDI-SCDIS  $  SCPR-SCPRE  S  SCTI-SCTIM 
C  THE  SCALES  ARE  NEEDED  IN  QFUNCT  WHICH  IS  CALLED  FROM  PFIELD 
C 

EXA-EXNU(I)  $  EXB-EXNUC2)  t  EXC>EXNU(3) 

C  STORE  EXPONENTS  TO  BE  USED  BY  THE  PRESSURE  FIELD  AUXILIARY  FUNCTIONS 
C  ACOEF,  BCOEF  AND  CCOEF 
C 

NXD-3  $  NPO«IO  $  NW0RK»1A307 
NBAD-0 

IFISCDIS.GT. 0.0. AND. SCPRE.GT. 0.0. AND. SCTIM. GT.O.OIGOTO  15 
N B AO ■ 1 S  PRINT  20,N8A0$  RETURN 


60 


65 


70 


75 


60 


65 


15  IF<NRPR0F.GT.1)G0T0  23 
N8A0-2 

PRINT  20,NBADJ  RETURN 

20  FORMAT ( 1H0, 10X, 29HRETURN  FROM  FTPFLD  WITH  NBAD-, 13) 

23  KCS-0  $  KC-0 

DO  35  KA-1»NRPR0F 

KBH-NSET(KA)  S  IF(KBN.LE.O)  GOTO  35 
DO  25  KB-1, KBM 
KC-KC  S>KB 

X<IT,KCI-TP<1,KC»/SCTIM  S  R<IT,IT»KC)*(ERTP<1,KCI/SCTIH)**2 
X ( IP*  KC l-TP<  2»KC I /SC P RE  $  R( IP, IP,KC)-<ERTP<2,KC)/SCPRE)**2 
X<3, KC)-DIST<KA)/SCDISS  R ( 3* 3* KC ) •< ERDI ST( K Al /SCDIS 1 **2 
R ( 1*  2*KC 1*0$  R< 1, 3,KC ) -0$  R<2,3,KC)>0 
R<2,1,KC>«0$  R<3,l,KC>-0*  R<3,2,KCI-0 
LSTX <  KC ) -0 

XC<2,KC)-X<2,KC)  t  XC<3»KC)*X(3»KC) 

C ( 2*  KC ) *0. 0  $  C( 3,KC)-0<0 

WORK <KC)-PIND<KA)/SCPRE  *  WORK <6000>KC » -TARD< K A » /SCT IM 
C  STORE  SHOCK  OVERPRESSURE  ANO  ARRIVAL  TINE  FOR  FLDGES 
25  CONTINUE 
KCS-KC 
35  CONTINUE 
NR-KC 
C 

PARG<S)-PAR<5) 

CALL  FLOGES<X,R,  WORK! 1  )*  WORM 6001 ) > NR,E  XNU,  PARG, NBAD I 
C  THIS  COMPUTES  BETTER  INITIAL  APPROXIMATIONS  OF  PARG 
IF  <NBAD<NE<0 IGQTO  39 

C  BRANCH  ANO  TRY  APPROXIMATIONS  PROVIDED  BY  CALLING  PROGRAM 
DO  38  KA-1»6 
38  PAR<  KA) -P ARG<KA) 


90 


95 


100 


105 


110 


39  CONTINUE 

DO  47  K A* 1*  6 
47  PSTIKAI-PARIKA) 

C 

NX-1  $  NP-5  $  ITYPE-0 

CALLCOLSACA<X,R, ALB, LSTX, NX, NR, PAR, NP, PFIELOC , ITYPE, 
AXC,C,LSTN,NRGD,ERZ, VP AR,ERPAR,NBAD,NXD,NPO, WQRK,NWORK) 
NX-2  $  NP-5  *  ITYPE-1 

IF(NBAO.EO.O)  GOTO  52 
C 

49  PARdl-PSTd)  S  P  AR  ( 2  )  -PSTC  31  $  P  AR  ( 3  I -PST  (  5 1 
NX-1  $  NP-3  S  I  TYPE-0 

CALL  COLS  AC A( X, R, ALB, LSTX, NX, NR, PAR ,NP, PLDAUX, I  TYPE, 

1  XC»C ,LSTN»  NRGD, ERZ, VPF, ERPAR* NBAD, NXD, NPD, WORK, NWORK) 
IF<NBAD<NE<OI  RETURN 
NX-2  t  NP-3  «  ITYPE-1 

C  ALL  C  OLSAC  A<  X, R, ALB, LSTX, NX, NR, PAR, NP, PLDAUX, ITYPE, 

1  XC»C,LSTN, NRGD, ERZ, VPF, ERPAR, NBAD, NXD, NPD, WORK, NWORK I 
IF<NBAD<NE<OI  RETURN 
NX-3  $  NP-3  S  ITVPE-l 

CALL  COLS  AC A< X,R, ALB, LSTX, NX, NR, PAR,NP, PLDAUX, ITYPE, 

1  XC,C»LSTN, NRGD, ERZ, VPF, ERPAR, NBAD, NXD, NPD, WORK, NWORK) 
IF<NBAO<NE<OI  RETURN 
PAR<5)-PAR<3)  %  PAR  <31  -PAR  <  2  ) 

P AR<  2 ) -PST<  21  *  PAR <  41 -PST<  4  > 


125 


115 

120 

125 

130 

135 

140 

.  EXCEEDS 


NX *3  $  NP«5  %  ITYPE*1 
GOTO  54 
C 

52  CONTINUE 

CALLCOLSACA<X,R, ALB»LSTX,NX,NR»PAR,NP»PFIELDC» I  TYPE* 
AXC*C*LSTN*NRGD»ERZ»VPAR*ERPAR»NBAD»NXD»NPD* WORK* NWORK ) 
NX«3  $  NP«5  *  ITYPE-1 
IF(NBAD.EO.O)  GOTO  54 
DO  53  KA«1»NR  S  XC ( 2»KA ) ■ X ( 2, KA ) 

53  C  (  2*  KA) *0. 

GOTO  49 

C 

54  CONTINUE 

C ALLCOLSAC A(X*R*  ALB*LSTX*NX*NR*PAR»NP»PFIELDC* I TYPE* 

AX  C*C  *  LSTN* NRGD* E  RZ*  VP AR*  ERP AR* NBAD*  NXD*  NPD* WORK*  NWORK I 
IF(NBAO.EO.O)  GOTO  55 
RETURN 

55  CONTINUE 

CALL  PRTFLOI SCDIS* SCPRE»SCTIN» TITLE *PRLAB*PRDSD#TARD» 

A  PIND,X,R» ALB,NR,C) 

C  PRINT  FIELD  ADJUSTMENT  RESULTS  IRESIDUALS) 

CALL  PLTFLD (TITLE* TARO* PIND* PAR* VPAR*  ERZ»NP»NRPROF) 

C  PLOT  OVERPRESSURE  FIELO  HISTORIES 
RETURN 
END 

131*071  WORDS  (LCH-I  REQUIRED) 


12  6 
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SUBROUTINE  FLOGE S ( X, R » PS, TS,NR»EXNU»PARG» NB AD) 

C  THIS  COMPUTES  INITIAL  APPROXIMATIONS  OF  FIELD  PARAMETERS  PARS. 

C  FLDGES  IS  CALLED  FROM  FTPFLD. 

C 

5  C  X  TIME, OVERPRESSURE, DISTANCE 

C  R  •  VARIANCE-COVARIANCE  MATRICES  OF  X 

C  PS  -  INCIDENTAL  SHOCK  OVERPRESSURES 

C  TS  *  SHOCK  ARRIVAL  TIMES 

C  NR  *  NUMBER  OF  DATA  POINTS 

10  C  EXNU  -  EXPONENTS  IN  OVERPRESSURE  FIELD  FORMULA 

C 

C  THE  FOLLOWING  WILL  BE  PROVIDED  BY  THIS  PROGRAM 
C 

C  PARG  •  FIELO  PARAMETERS 

15  C  N0AO  -  ERROR  INDICATOR.  NBAD.NE.O  IN  CASE  OF  ERROR  RETURN 

DINENSIQNXI3, 5000 ) , R( 3, 3, 5000 1 , PS ( 5000 1 , TS ( 5000 » , EXNUl 3 » , P ARG( 101 
LEVEL2,X,R,PS,TS 

20  COMNQN/TPINOX/ITC»IPC 

C  X(  ITC,K I ■  TIME,  X(IPC,K I "OVERPRESSURE 
CQMMQN/GUEC  M/ AN( 3,3),RS(3),W(18) 

DOUBLE  PRECISION  AN,RS,W,OET 
LEVEL  2  »AN» RS, tf 
25 

NBAO-O 

F  H  IN  »  X  (  IPC,1)RX(3,1)**EXNU(3I  %  FMAX-FMIN 
00  15  KA-2»NR 
F  F-X  l 3, KA ) **E  XNU I  3  I 

30  FMIN-AMIN1(FMIN,XCIPC,KA)*FF,PSIKA)*FF» 

FMAX-AMAXHFNAX,X(IPC,KA)*FF,PS<KA)*FF) 

15  CONTINUE 

CMAX-FNIN-ABSCFHAXI*0.001 
35  CMIN-ANINM— 0.5*ABSIF  MAX  I , CMAX ) 

C*AMIN1(CMAX,AMAX1(PARG(5),CNIN)) 

25  KIT-0 

C  KIT  IS  ITERATION  COUNTER 
AO  NX-3  *  NA-3  %  KIN-l 

IF(CMIN.EO.CMAX)  NX-2 

C  NEXT  ESTABLISH  NORMAL  EQS  FOR  SIMPLIFIED  PROBLEM 
35  DO  55  KA-1,3  S  DO  45  KB-1,3 
45  45  AN(K A, KBI - 0 

55  RS(KA)-0 

C  THE  FITTED  FUNCTION  IS  OF  THE  FORM  Y-F (A, B » , I .  E.  , 

C  ALOG< ( P-CO ) I ( PS-C D ) )-AD*C  T-TS ) >60* (T-TS>**2, 

50  C  WHERE  AD- A/D**EXNU( 1 > ,  BD-B/D**EXNU<2I, 

C  CR«C/D**EXNU(3)»  AND  D  IS  DISTANCE 
C  THE  WEIGHTS  ARE  <P-CD»**2/R 

C  THE  FIRST  TERM  IS  LINEARIZED  FOR  CORRECTION  EPS  OF  C 
C  INITIAL  VALUE  C-PARGI5I  PROVIDED  BY  CALLING  PROGRAM 
55 

00  65  K A- 1 , NR 

PC-XI IPC,KA)-C/X( 3,KA)**EXNUC  3) 


127 


PSC-PS  €  KA  »-C/X€  3»KAI*«EXNU<  3 » 
ERF«PC**2/R4IPC»IPC»KAI 

TAU-4X4ITC»KA)-TS4KA>  ) /X4 3» KA> **EXNU4 1» 

TAUS- 4X4ITC»KAI-TS4KAJ)**2/X43»KA)**EXNU42) 

RO-4  PSC-PC »  / ( P$C*PC*X 4 3»KA)**EXNU43  » » 
AL-AL0G4PC/PSCJ 
AN41#ll-AN41»mERF*TAU**2 
AN41#2I-AN41»2)*ERF*T  AU*T  AUS 
AN (1 » 3)  -  AN  41»3)*ERF*T  AU*RO 
RS41)«RS41I*ERF*TAU*AL 
AN42»2)-AN42»2)^ERF*TAUS**2 
AN42»3)-AN4  2»3UERF*TAUS*RO 
RS42I-RS42I  ♦ERF*TAUS*  Al. 

AN43»3)-AN4  3*3I+ERF*R0*^2 
RS  43 ) -RS  4  31 ♦ERF*RO*AL 
65  CONTINUE 

AN  42*  l ) -AN I 1*2)  $  AN43,ll-ANtl,3)  %  ANI  3,21  -AN4  2,3» 

CALL  NTRINOB4AN»NX*RS»NA»KIN»DET»y> 

C  THIS  SOLVED  THE  NORMAL  EQUATIONS 

IF4NX.EQ.2.QR.DET.NE.O.IGOTO  T5 
NX-2  $  NA-3  *  KIN-1 
GOTO  35 

75  EPS-RS4  31  %  IF4NX.EQ.2)EPS-0 
C-AMAX14CNIN#AHIN14C>EPS»CHAX> ) 

IF(CNIN.EQ.CMAX)  GOTO  85 
C  NO  ITERATION  FOR  C  IF  C  IS  FIXED 
KIT-KIT+1 

NX-3  $  NA-3  *  KIN-1 
IF4KIT.LT. 416QT0  35 
C  ITERATE  THREE  TIMES 

85  P ARG4 1 )-RS41)  $  PARG4  3I-RS42I  $  PARG45I-C 
PARG 4  21*0  *  PARG441-0 
IF4DET.EQ.0.)NBAD«1 
RETURN 
END 
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SUBROUTINE  PFIELD<X«KK»PAR#F»FX»FP»FXX»FXP»  FPP*  NBAD I 


5 


10 


15 


20 


25 


30 


35 


50 


55 


50 


55 


C 

C  THIS  IS  THE  OVERPRESSURE  FIELD  FUNCTION  CONSTRAINT  ROUTINE 
C  THE  ARGUMENTS  ARE  EXPLAINED  IN  COLSACB  AND  IN  COLSAC  MANUAL 
£ 

C  THE  FUNCTION  F  IS  DEFINEO  AS 

C  F* (PSHOCK-C JK*EXP(Q(T»R»P(1 1 » .  .  .  >  P  (  5 ) ) »C ( R»  P( 5 ) )  -  P 

C  THE  OBSERVABLES  ARE 

C  TINE  T=X(IT>,  OVERPRESSURE  P»X(IP)>  RADIUS  R-XI3I 

C  THE  INDEXES  IT  AND  IP  ARE  IN  COMMON/TPINDX/ 

C  THE  FUNCTIONS  Q,PSHOCK,C  WILL  BE  OBTAINED  BY  CALLIN6 
C  OFUNCT  AND  CCOEF. 

C 

LEVEL  2#X»FX»FP»FXX»FXP»FPP 

DIMENSION  X(3»1)»PAR(10)»FX<3)»FP(10)»FXX(3»3>»FXP(3»10J*FPP(10»10 
1) 

DIMENSION  QX(3)»QP(10>»QXX(3»3)»0XP(3»10)»0PP(10»10)»CX(3)» 
ACP(10>»CXX(3»3)»CXP13»10I»CPP(10»10)»PSPI10I»PSRP(10I#PSPP(10»10I 
DIMENSION  PSCX(3)#PSCP(10» 

C 

COMMON /TP  INOX/ IT  t IP 
C  /TPINOX/  IS  SET  BT  FTPFLO 

C  T I  ME  *  X  t IT)  ,  OVERPRESSURE»X(IP>»  DISTANCE*!! 3) 

C 

NPSHK-4  S  GOTO  10 
ENTRY  PFIELDC 
NPSHK-0 
10  CONTINUE 
C 

C  ENTRY  PFIELDC  IS  USEO  AS  CONSTRAINT  FOR  PRESSURE  FIELD  ADJUSTMENT 
C  IT  DOES  NOT  COMPUTE  DERIVATIVES  WITH  RESPECT  TO  THE  SHOCK 
C  PARAMETERS  PARI6J  THROUGH  PARI  91 
C 

C  ENTRY  PFIELD  IS  USEO  TO  COMPUTE  THE  PRESSURE  FIELD  AFTER  ADJUSTMENT 
C  IT  COMPUTES  DERIVATIVES  OF  THE  OVERPRESSURE  WITH  RESPECT  TO 
C  ALL  PARAMETERS 

C 

DO  12  KB-lflO 

FXPI 1»KB)*0  %  FXP(2»KB) *0  %  FXP(3»KB)-0  $  FPIKBI-0 

DO  12  KC*  1» 10 
12  FPP! KC >  KB  I *0 

NBAD*0 

CALL  QFUNCT(X»KK»PARt Q»QX»QP»QXX,OXP,QPP, 

APS»PSR»PSP»PSRR»PSRP» PSPP»NPSHK,NBAO) 

IF(NBAD.NE.O) RETURN 

CALL  CCOEFI X»KK»PAR,C»CX,CP»CXX,CXP,CPP#NBAD) 

I F(NB  AD*NE • OIRETURN 
C 

13  EXPO-O.O 
PSC-PS-C 

IF!0.GE.-675.85. AND. O.LE. 751.671  EXPQ-EXPCQ) 

IFCQ.LE.100.)  GOTO  15 

C  LARGE  EXP  HAS  CAUSED  OVERFLOW  IN  COLSAC 
IFIQ.LE.751.67)  GOTO  15 
NBAO* 101 
RETURN 
15  CONTINUE 
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FEX»PSC*EXPO 

F«FEX4C-X<IP*KK» 

00  15  KB» 1»  3 
PSCX(KB)*- CX(KB) 

15  FX(K8I*EXPQ*( PSC*QX (KB)+PSCX(KB))+CX(KB) 

FX(IP)»FX( IP  1—1. 

PSCX(3)>PSCX(3)+PSR 
FX(3 ) »FX( 3I+EXPQ4PSR 
00  25  KB* 1» 5 
p$ CP  C  KB )*-CP< KB ) 

25  FPIK  B )*EXPQ*( PSC*QP (KB1+PSCP (K  B  H^CPCKB) 

C 

00  32  KB*1»  3  $  DO  32  KC*1»3 

FXX(K8»KCI«EXPQ*(PSCMQXXCKB»KC>*QX(KB>*QX(KC> I 
A*QX(KB)*PSCX(KC)*PSCX(KB)*QX(KC  )-CXX( KB»  KC  )  )*CXX(KB,KCI 
32  CONTINUE 

FXX(3»3I*FXX(3»3)*EXPQ*PSRR 

C 

DO  35  KB* 1» 3  $  00  35  KC*1»5 

FXP(  K 8#  KC 1 «EXPQ*C  PSC*  (QXP(KB»KC> ♦OXIKB) *0PI KC 1 1 
A+QX(KB)*PSCP(KC)+PSCX(KB)*OP(KCI-CXP(KB»KCI)*CXPCKB»KCI 
35  CONTINUE 
C 

00  45  K8*l»  5  $  00  45  KC-1»5 

F  PP( KB#KC ) -E  XPQ*( PSC* (QPP 1KB»  KC 1+QP (KBI*QP(KCI) 
A*QP(KBI*PSCP(KC!*PSCP(KB>*QP(KC>-CPP(KB»KC> )*CPPCKB»KCI 
45  CONTINUE 
C 

IFINPSHK.LE.OIGOTO  75 

C  NPSHK  IS  THE  NUNBER  OF  SHOCK  PARANETERS.  NPSHK-0  OR  -4 
KUP«5*4 

C  ASSUME  THAT  PRESSURE  FUNCTION  HAS  5  PARAMETERS  AND  SHOCK  HAS  4  PAR. 
00  55  KB-6.KUP 
PSCP(KB)*PSP(KB) 

FP(KBI-EXPd4f PSC*QP(KB)4PSCP(KB)) 

DO  52  KC*1; 3 

FXP(KC,KB)-EXPQ*(PSC*C0XP(KCfKB»+QX(KC)40PCKBI I 
A+QX(  KC I *PSCP(KB l  +  PSCX (KC l*QP(KB) ) 

52  CONTINUE 

FXP(3»KB)-FXP(3>KB)*EXPQ*PSRP(KB) 

00  55  KC*6»KUP 

FPP(KB,KC)*EXPQ*(PSC*(QPP(KB»KC)*QP(KB>40P(KC> 1 
A+QP(KB)*PSCP(KC>*PSCP(KBI*QP(KC)4PSPP(KB»KCII 
55  CONTINUE 

00  65  KB*1»S  %  00  65  KC*6»KUP 

FPP(KB»KC)«EXPQ*(PSC*(QPPtKB»KCl4QP(KB)*QP(KCl I 
A+QP(  KBI*PSCP(KCI^PSCP(KB)*OP(KC)*PSPP(KB»KCn 
65  FPP(KCtKB»«FPP(KB»KC» 

75  CONTINUE 
RETURN 
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SUBROUTINE  PLDAUX ( X,KK*PAR, F»F X# FP, FXX» FXP» FPP# NBADI 
C  THIS  CONVERTS  THE  FIVE  PARAMETER  PRESSURE  FIELD  FUNCTION  INTO  A 
C  THREE  PARAMETER  FUNCTION.  IT  IS  USED  BT  FTPFLD  IN  CASE  OF 
C  ALGORITHMIC  PROBLEMS  TO  OBTAIN  INITIAL  APPROXIMATIONS  FOR 
C  THE  FINAL  FIVE  PARAMETER  FITTING 
C 

DIMENSION  XI3»1)»PAR(10)»FX(3)»FP(10)»FXX(3»3)»FXP(3»10)» 

1  FPP(10»10)»P(10) 

LEVEL  2*X»FX#FP»FXX»FXP»FPP 
C  OMM ON /SCR CHAT  GP 1 101 #GXP ( 3, 10 I »GPP <10# 101 
LEVEL  2»GP»GXP»GPP 
C 

Pill "PARI  1 I  S  P l 3 )«  PAR (2)  *  PC  5 »  «  PARC  3  >  %  P12I-0  %  PlAI-0 
CALL  PFIELDC(X»KK#P»F »FX»GP»FXX#GXP»GPP»NBAO) 

DO  15  KA-1*3  S  FP(KA)«GP(KA*2— 1) 

00  15  KB-1.3  $  FXP(KB»KAI«GXP(KB» KA*2— 1 1 

15  FPP(KB»KA)«GPPl KB +  2—1 »  KA*2-1 1 

RETURN  $  END 


r>  o  o  o  o  o 


S  uBROUT  INE  OFUNCT  (  X,KK»PAR,Q,QX,QP»QXX»  QXP»GPP, 

APS,»SR  ,  PSP.  PSRR  ,  PSRP,  PSPP.NPSHK.NBADI 
AUXILIARY  ROUTINE  FOR  PEIELD.  IT  COMPUTE  S  THE  EXPONENT  a  OF  THE 
PRESSURE  FIELD  FUNCTION.  IT  ALSO  Tk.  HITS  THE  SHOCK 
OVERPRESSURE  PS(R>  WITH  DERIVATIVES. 

SUBROUTINES  ACOEF.BCOEF  AND  SHODER  ARE  NEEDED 

LEVEL  2.X 

DIMENSION  X(3,l),PAP(10),QX(3),QP(10),QXX(3,3)»QXP(3»10), 
AOPP(10»10)»AX(3)»AP(10>»AXX(3»3)»AXP<3.10)»APP(10.10)» 

BT AUX (3) 

DIMENSION  TP(10),TRP( 10>,TPP< 10, 10) , PSP ( 10) , PS RP < 10 ) , PSPP < 10, 1 0 > 

C 

COMMON/CSC AL£/SCDIS»SCPRE,SCTIM 

COMMON/COMSHK/NPSH  . P ARSH < 4  I » VP ARSH C 4, 4 ) » SC DSH, S CPS H, SC TS H 
C 

COMMON/TP INDX/IT, IP 
C  / T  PI NDX /  IS  SET  BT  FTPFLO 

C  TI ME*  X< I T I  ,  OV£RPRESSURE«X(IP)»  DISTANCE«X( 3) 

C 

DO  12  KA* 1.10  4  OPIKAI-O  $  DO  IC  KB»1#3 
10  QXP(KB,KA>*0  $  DO  12  KC«1,10 
12  CPP( K A. KC I *0 

NBAO-O  4  R*X(3»KK)*SCDIS 
C 

IFINPSHK. GT.O)  GOTO  13 

C  IF  NPSHK  «  NUMBER  OF  SHOCK  PARAMETERS  IS  ZERO  THEN  COMPUTE  ONLY 
C  DERIVATIVES  WITH  RESPECT  TO  PRESSURE  PARAMETERS  PAR(l)  THROUGH  PAR  1 5 ) 
CALL  SHQCK2<R»T»TR,TRR»PS»PSR*PSRR»NBAD) 

IF (NB AD.NE . 0 )  RETURN 
GOTO  14 
C 

13  CONTINUE 

CALL  SHODERI  R, T, TR,TP, TRR, TRP,TPP,PS, PSR, PSP, 
APSRR,PSRP,PSPP,NBAO) 

IF(NBAD.NE.O)R£TUP,N 

C 

14  CONTINUE 

C  SH0CK2  OR  SHOOER  CGMPUTEO  EVRYTHING  IN  SI  UNITS.  NOW  SCALE  RESULTS 
C  ACCORDING  TO  THE  SCALES  IN  / (.SCALE/ 

T-TTSCTIM  4  TR*TR*SCniS/3CTIN  4  T RR -TRR*SC D I S*» 2 /SCT IM 
PS»PS/5CPRE  4  PSR«PSR*SCDIS/SCPRE  4  PSRR«PSRR*SCDIS**2/SCPRE 
IMNPSHK.  LE  .0»  GOTO  16 
C 

0  0  14  KB*  6,1} 

TP(KB)*TP(KB)*SCPPE*SCDJS*MKB-5T/SCTIN 
PSP(KB)«PSP(KB)*SCDIS**CKB-5> 
TRP(KB)«TRP<KB)*SCPlS*MKB-4M>SCPRE/SCTtM 
PSRPI  KB)*PSRP(KB)*SCDI5*MK6-4) 

TPP(  9, KB)  »TPP(9,KB)*SCPRE*SC0IS**IKB-5)  *  T PP ( KB, 9 > -TPP t 9,KB > 
PSPP ( 9, KB ) *PSPP«  9,KBI ♦SCT IN* SC  DIS** (KB-5)  4  P S P P( KB, 9 1 -PSP P I  9, KB  1 

0  0  1  ?  k  C  *■  >  *  B 

TPP<  KC, KB) *TpP(KCrK3> ♦(SCPRE / S C T I M > ** 2* SC D l S * ♦ t K B*K C-l 0 » 
PSPP(KC,KB)-PSPP»KC,KB)4SCDIS**(KB»KC-10) 

15  CONTINUE 
PSP(9)*PSP(9)*SCTIM/SCPRE 


T PP<  9» 9»«TPP<9,9)*SCTIM 
PSPP<9,9»*P$PP(9,9»*< SCTIM/SCPRE>**2 
C 

16  CONTINUE 

TAU*X< IT»KKI-T 

T  AUX ( IT  > *1 <0  t  TAUX<IP|-0.0  $  TAUX(3»*-TR 
C 

C  NEXT  COMPUTE  THE  LINEAR  TERN  IN  THE  EXPONENT 

CALL  ACOEF(X»KK>PAR»A»AX»AP»AXX»AXP»APP»NBAD) 
IFtNBAD.NE.OtRETURN 
Q*  A*T  AU 
C 

DO  25  KB*1#  3 

QX<KB)-AX(K8»*TAU*A*TAUXCKBI 
DO  25  KC-1.3 

QXX(KB*KC)*AXX(K8>KC)*TAU+AX(KB)*TAUX<KC)+AX(KC)*TAUX(KBI 
25  CONTINUE 

QXX<  3»3)*QXX(3>3 )-A*T RR 
C 

DO  35  KB-1,3  5  DO  35  KC*1»5 
35  QXP(KB»KC)*AXP<KB»KCI *TAU*AP(KC)*TAUX(KB) 

C 

DO  45  KB* 1 »  5  S  OPCKBI *APIKB)*TAU 
00  A 5  KC-1»5 

45  QPPl KB  >  KC ) *APP(KB»KC)*TAU 
IF(NPSHK.LE.O)GOTO  53 

C  NPSHK  IS  THE  NUMBER  OF  SHOCK  PARAMETERS 
KUP*5*NPSHK 

C  ASSUME  THAT  PRESSURE  FIELD  HAS  5  PARAMETERS 
DO  48  K  A*6  » KUP 
QPCKAI— A*TP<KA1 

QXP<  3#KAI*— AX<3 ) *TP CK A )— A*TRP ( KA 1 
00  48  K8*6»KUP 
48  QPP(KA,KBJ*-A*TPP<KA»KB> 

DO  50  KA-1,5  $  DO  50  KB-6,KUP 
QPPIKA,KB>—  AP(KA)*TP(KB) 

50  QPP(KB»KA>*QPP<KA»KBI 
C 

C  NEXT  COMPUTE  QUADRATIC  TERM 

53  CALL  8CQEF(X»KKrPARrA»AX»APrAXX»AXP»APP»NBAD) 
IF<NBAD<NE<OIRETURN 
Q*Q>A*TAU*TAU 
C 

DO  55  KB-1,3 

QX{KB)*QX<KB)*TAU*< AX(KB)*TAU*2.*A*TAUX(KB) I 
DO  55  KC*1»  3 

QXX(KBfKC)*QXX(KB»KC)+TAU*(AXX(KB»KC)*T AU  +  2  <*  AX <  KB  1 *TAUX ( KC » 
A*2.*AX(KC)*TAUX(KB) ) ♦ 2. * A*T AUX < KB J * TA UX < KC ) 

55  CONTINUE 

QXX( 3# 3)«QXX<3f 3»-2.*A*TAU*TRR 
C 

00  65  KB=l»  3  S  DO  65  KC*1»5 

QXP(KB»KC)«QXP(KB»KC) ♦  TAUM AXP(KB»KC|*T  AU*2<* 
ATAUX(KBI*AP<KC) 1 
65  CONTINUE 
C 

DO  75  KB* 1»  5  t  QPIKBI *QP< KB » ♦ APIKB) *TAU*TAU 
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00  75  KC«1»5 

75  QPP(KB»KC)*QPP(KB»KC) ♦APP(KB»KC)*TAU*TAU 
IFINPSHK.LE.0IG0T0  97 
DO  85  KA-6#KUP 

QPIKAI«QPfKAI-A*2.*TAU*TP<KA) 

120  QXP<  3»KA)*QXP(3»KA)*2.*<-AX(  3)*TAU*TP(KAI*A*TPIKA)*TR 

A— A*T  AU*TRP  < KAI I 
00  85  KB* 6» KUP 

QPP(KA»KB ) *QPP(KA»KB) *A*2.* (TP (KA)*TP(KBI— T  AU*TPP(KA»KB I ) 
85  CONTINUE 

125  DO  95  KA*6» KUP  $  00  95  KB*1,5 

QPPC  KB»KA)*QPPt KB»KA)-2.*AP (KB )*TP( KA)*TAU 
95  QPP( KA>KB ) *QPP(KB»KA) 

97  CONTINUE 
RETURN 

130  END 
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SUBROUTINE  ACOE F  (  X» KK  t? AR»  A,  AX»  AP»  AXX»  AXP>  APP»  NB  AD) 

C  LINEAR  COEFFICIENT  IN  PRESSURE  FIELD  EXPONENT 
C  AUXILIARY  ROUTINE  FOR  OFUNCT 

DIMENSION  X<3,1»»PAR(10)* AX (3) , AP( 10> » AXXC 3» 3> » AXPC 3» 10> » 
AAPP( 10,10),CP(2»,CXP<2>,CPP<2,2> 

LEVEL  2»X 

C  OHNON/CFLD  EX/EX A*  EXB»  EXC 
NBAD-0 

R*X( 3t KK)  %  P1-PARI1I  $  P2-PARC2) 

EX-EXA 

CALL  COEF  FI(R»P1»P2>EX*A»CX>CP»CXX»CXP»CPP>NBAD) 

IF (NB AD*EQ«0) GOTO  15  $  NB AD*NB AD  +  100  $  RETURN 
C 

15  DO  25  K  A* 1 »  5  $  AP(KA)«0  t  IF (K A. LE. 3) AX ( KA> -0 
DO  25  KB«1»5  $  IF(KA.LE. 3)AXP(KA>KB )*0 
IF(KA.LE.3.AND.KB.LE.3)AXX(KA>KB)«0 
25  APP(KA,KB)-0 
C 

AX(3I>CX  $  AP(1)-CP(1)  S  AP(2I-CP(2) 

AXX(3,3»*CXX  $  A  XP  (  3»  1 )  *C  XP  (  1 )  $  AXP(  3»  2)»CXP  (  2  > 

DO  35  KA«1»2  $  00  35  KB«1,2 
35  APP(KA»KB»-CPP(KA»KB> 

RETURN  t  END 
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SUBROUTINE  8COfcF(X.KK,PAF:>A,AX,AP»AXX,AXP,APP,N8AD) 
C  QUADRATIC  COEFFICIENT  IN  PRESSURE  FIELD  EXPONENT 
C  AUXILIARY  ROUTINE  FOR  Qf-UNCT 

01  HE  NS  ION  XI 3,1) , PARI  10) , AXI 3) >AP< 10) ,AXX( 3,3) , 
AAXP<3,10)»APP110,10)»CPI2),CXPI2),CPP12,2> 

LEVEL  2  »  X 

COMHON/CFLDfcXXEXA,EXB*EXC 

N8A0-0 

R»X(3,KK)  »  P  i*  P  AR  !  3 !  i  P2*PAR(4) 

EX-EXB 

CALL  C0EFFI(R»P1,P2«EX,A,CX,CP,CXX»CXP»CPP,N3AD! 
IF(N8AD.£Q.O)GOTO  15  %  N8 AD-200+NBAD  J  RETURN 
C 

15  DO  25  KA=1,5  t  AP<<A)»0  S  I F I K A. L E . 3 ) AX t K A ) «0 
DO  25  KB*1,5  *  IFIKA.LE.3)AXPlKA,KB)*0 
IFIKA.LE. 3. AND.KS.LE. 3 » AX  X < K A , KB ) *  0 
25  AP  PI K  A, KB ) *  0 
C 

AX (3 ) *C  X  *  AP (3 ) *CP ( 1  )  i  AP(4)»CPI2) 

AXX(3,3)»CXX  $  AXPI 3, 3 ) *C  XP  I 1)  $  AX P ( 3, 4 ) *C XP I  2 > 

DO  35  K A* 1 , 2  $  DO  35  KS*1,2 
35  APPI2+KA, 2+K8)*CPP(KA,KB) 

RETURN  %  ENO 


SUBROUTINE  CCOEF ( X» KK» PAR, A, AX, AP> AXX, AXP» APP» NBAD» 

C  THIS  IS  ADDITIVE  COEFFICIENT  IN  PRESSURE  FIELD  FORMULA 
C  AUXILIARY  ROUTINE  FOR  PFIELD 

DIMENSION  X( 3»1 1  *  PARI  101, AXC 3 1 »AP(10)» AXX( 3, 3) » AXP( 3, 101 
AAPPC 10»10),CP{2I,CXP(2),CPP(2,2» 

LEVEL  2,X 

C  QMM  0 N  /  CF  L  OE  X /E  X  A  »  E  XB  »  E  XC 
NBAO-O 

R*X( 3 »KK)  $  P1«PAR(5>  S  P2-0. 

EX-EXC 

CALL  C0EFFI(R,Pl,P2,EX,A,CXf CP,CXX»CXP»CPP»NBAD) 
IFCNBA0.EQ.0I60T0  15  S  NB AD*NB AD+300  t  RETURN 
C 

15  DO  25  KA» 1»  5  %  AP(KA)-0  $  I F ( K A. LE. 3 ) AX ( KAI «0 
DO  25  KB*1»  5  %  IF(KA.LE.3)AXP(KA»KB)«0 
IF(KA.LE.3. AND.KB.LE. 3)AXX(KA,KB) »0 
25  APP( KA»KB 1*0 
C 

AX (3 ) *CX  $  AP (5 ) «CP (1 ) 

AXX(  3»  3 )*  C  X  X  t  AXP( 3,5>-CXP(l> 

APP( 5»5)«CPPC1»1) 

RETURN  $  END 


SUBROUTINE  COEFF II R» P It P2» E X, A, AX, AP» AXX» AXP, APP.NB AO) 

C  THIS  COMPUTES  TAU  COEFFICIENTS  TO  BE  USED  IN  PRESSURE  FIELD 
C  FUNCTION  EXPONENT  AND  AS  AODITIVE  TERN.  THE  COEFFICIENTS  DEPEND  ON  R 
C 

DIMENSION  AP<2>» AXP(2),APP(2,2> 

C 

NBAO-O 

REX«1./R**EX 

A-REX*CP1>P2*R» 

C  A  IS  THE  COEFFICIENT.  NEXT  COMPUTE  FIRST  ORDER  DERIVATIVES 
AX»REX*C-P1*EX/R*P2*C l.-EXI » 

APdl-REX  *  AP(2I«REX*R 
C  NEXT  COMPUTE  SECOND  OROER  DERIVATIVES 

AXX-REX*CP1*EX*<EX*1. )/R-P2*(l.-EX)*EX)/R 
AXPCl)-REX*(-EXI/R  t  AXP(2)«REX*(1.-EX> 

APP(1»1)»0.  $  APP ( I>  2  )  *0.  t  APPC2#1I*0.  $  APP(2»2I«0. 

RETURN  $  ENO 
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SUBROUTINE  SHOCK(R,T,  POV, US, UP, RHO, NB AD > 

C  THIS  COMPUTES  SHOCK  VALUES  USING  PARAMETERS  FROM  /COMSHCK/ 

C  ALL  ARGUMENTS  ARE  ASSUMED  TO  BE  EXPRESSED  IN  SI  UNITS 
C  ROUTINE  USES  ROMBIN  AND  SHTINT  TO  COMPUTE  SHOCK  ARRIVAL  TIME 
5  C 

C  R  SHOCK  DISTANCE  (GIVEN) 

C  T  SHOCK  ARRIVAL  TIME 

C  PQV  -  INCIDENTAL  SHOCK  OVERPRESSURE 

C  US  «  SHOCK  SPEED 

10  C  UP  PARTICLE  VELOCITY  BEHIND  SHOCK 

C  RHO  •  SHOCK  OENSITT 

C  NB AD  -  ERROR  INDICATOR.  NBAO.NE.O  IN  CASE  OF  ERROR  RETURN 

C 

EXTERNAL  SHTINT 

15  C  INTEGRAND  TO  COMPUTE  SHOCK  ARRIVAL  TIME 

C 

C0MM0N/C0NSHKVNPS,PARSHC4I, VP ARSH(4,A ), SCOIS,  SCPRE, SCTIM 
C OMMON / AMBCHA /P Z, T Z» GAM, AMOL, CHVOL, CHEN »CHH,CHHER 
C OMMON/ CF2DER/GAHCAP, SNDSPD, P AR(4 I, ALOW, SCD, SCP, SCT 

20  C 

GAMC  AP*GAMC  AP/SCP  $  SNDSPD»SNOSPO*SCD/SCT  S  ALOW-ALOW«SCO 
SCD«1.  %  SCP-1.  $  SCT-1. 

DO  15  KA-1,3 

15  PAR(KA)«PARSH(KA)*SCPRE  *SCOIS**KA 
25  PAR( A)»PARSH(A)*SCTIM 

C  THIS  CHANGED  THE  CONTENTS  OF  /CF2DER/  INTO  SI  UNITS 
C 

POV«( (PAR(3)/R>PAR(2)  )/R+PAR ( 1 ) )  / R 
CALL  ROMBIN( SHTINT, ALOW,R,F,NB AD) 

30  C  QUADRATURE  TO  COMPUTE  SHOCK  ARRIVAL  TIME 

IF(NBAD.EQ.O)  GO  TO  30 
PRINT  20, NBAO 

20  FORMAT ( 1H  »*RETURN  FROM  SHOCK  WITH  NBAD*  *,I5) 

RETURN 

35  C 

30  CONTINUE 

T-F/SNOSPO  ♦PAR(A) 

US»SQRT(SNDSPD**2*( 1. ♦GAMCAP*POV) ) 

RHOZ* (AM0L/8.31A3)*(PZ/TZ) 

AO  UP*POV/(RHOZ*US) 

RHO»RHOZ*< l.*GAMCAP*POV)/( l.M GAM-1. )*P0V*0.5/(  GAM*PZ) ) 

RETURN 

END 
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SUBROUTINE  SHOCK 2 (R, T» TR, TRRf  P * PR# P RR# NBAD ) 

C  THIS  ROUTINE  COMPUTES  SHOCK  ARRIVAL  TIME  AND  OVERPRESSURE  FOP 
C  GIVEN  DISTANCE 
CC 

C  R  =  SHOCK  DISTANCE  (GIVEN! 

C  T  *  SHOCK  ARRIVAL  TIME 

C  TR,  TRR  »  DERIVATIVES  OF  T  WITH  RESPECT  TO  R 
C  P  *  SHOCK  OVERPRESSURE 

C  PR»  PRR  ■  DERIVATIVES  OF  P  WITH  RESPECT  TO  R 
C 

C  ALL  QUANTITIES  ARE  COMPUTED  IN  SI  UNITS 
C 

EXTERNAL  SHTINT 

C0MM0N/C0NSHK/NPS#PARS(4)#VP( 4# 4 ) # SCDS» SCPSfS C T S 
COMMON/CF  2DERVGAMCAP# SNDSPD# C P ( A) # ALOW. SCD# SC P» SCT 
C 

GANCAP»GANCAP/SCP  t  SNOSPD=SNDSPD*SCD/SCT  $  ALOW«ALOW*SC 

SCD-1.  $  SCP«1.  $  SCT*1  • 

DO  15  K  A»  1#  3 

15  CP(KA1«PARS(KA)*SCPS*SCDS**KA 
CP(4!«PARS(4)*SCTS 

C  THIS  TRANSFORMED  /CF2DER /  INTO  SI  UNITS 
C 

CALL  ROMB  IN(SHTINT»ALQW#R»T#NBAD! 

IF(NBAD.EQ.O)  GO  TO  30 
PRINT  2 0>  NB  AO 

20  FORMAT ( 1H  t *RETURN  FROM  SHOCK 2  WITH  NDAD«  *#I5J 
30  CONTINUE 
C 

P«((CP(3)/R*CP(2I)/RPCP(1))/R 
PR  — ( (3.*CP(31/R*2.*CP(2) ) /R*C P ( 1 > > /R**2 
PRRM (12. *CP(3! /R*6«*CP(2))/R+CP(1) !/R**3 
T«T/SNDSP0*CP(4> 

SQ*1 • ♦GAMC AP*P 

TR»1.  MSQRT(SQ!*SNDSPO) 

TRR— 0.5*GAMCAP*TR*PR/S0 

RETURN 

END 


SUBROUTINE  SHTINTt X»F «NBAD) 

C  INTEGRAND  FOR  SHOCK  ARRIVAL  TINE  CONFUTATION 
C 

C  ONNON/CF  2DER/GANCAP*  SNDSPO*  P AR( 4) >  ALOV»SCD»SCP»  SCT 
C 

IF(X.GT.l.E-lO)  GOTO  IS  $  NBAD-1  %  RETURN 
15  SQ«l.«GANCAP*<(PAR(3l/X*PAR(2>  >/X+PAR(m/X 

IFtSO.GT.l. E-lOO)  GOTO  25  $  NBAO-2  $  RETURN 

25  F«l. / SORT (SO)  $  NBAD-0 

RETURN 
END 
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SUBROUTINE  ROHBIN  ( F, A,B, PINT, NBADI 
C  ROMBERG  INTEGRATION  SUBROUTINE 
C 

DIMENSION  T(10»20)»C0RKM(10) 

C 

NBAO-O 

CALL  F(A,FA,NBAD)  %  I F (NB AD. NE .0 ) RETURN 
CALL  F(B»FB#N8A0I  $  I F ( NB AD .NE . 0 » RETURN 
T(1»1I*(FA*F8)*0.5 
KH*1  $  KMA-1 
C 

15  DEN* FLOAT ( KHA 1*2.  $  FM-0 
DO  25  KA* 1* KMA 
AC«FL0AT(1*2*(KMA-KA) ) /DEN 
BC«FL0AT(2*KA-1)/DEN 
ARG*  AC*  A*BC*B 

CALL  F( ARG»FN»N8ADI  S  IFINBAD.NE. OJ RETURN 
FM*F  M>FN 
25  CONTINUE 

FM*FM/FLOAT  (KMA) 

T(1»KH-*1I*(T(1#KM) >FM 1*0.5 
C  THIS  IS  TRAPEZ.  NOW  COMPUTE  ROMBERG 
K  H  *K  M  ♦  1  t  KC«1  $  DOEN-1. 

35  KC*KC*1  $  DDEN*DDEN*4. 

C  ORKM  (  KC)  *  (  T(  KC— 1»  KMI  -  T<  KC_l*KM**l))/(  DDEN— 1 .  ) 
T(KC»KM)*T(  KC— 1»  KM >  *C  ORKM (KC ) 

IF (KC.LT.KM.ANO.KC.LT .10) GOTO  35 
IF(KC.GE.3 IGOTO  45 

C  AFTER  AT  LEAST  3  STEPS  BRANCH  TO  45  AND  TEST  CONVERGENCE 
KMA*KMA*2  S  GOTO  15 
C 

45  DO  55  KA-2»KC 

TEST* ABS(CQRKM(KA) ) 

IFCTEST.LE. ABS(T(KC,KM) )*1.E-10)G0T0  65 
IF(TEST.LE.1.E-100)G0T0  65 
55  CONTINUE 

IF (KM. GE. 20 IGOTO  65 

C  COMPUTE  NOT  MORE  THAN  20  ROMBERG  CORRECTIONS 
KMA-KMA*2  $  GOTO  15 
C 

65  FINT*T(KC»KM)*(B-A) 

RETURN 
EN 
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SUBROUTINE  PRTFLD! SCO  IS, SCPRE, SCT IN, TITLE* PRLAB, PRDSO# 

A  TARD»PIND»X,R, ALAB»NR,C> 

C  THIS  IS  CALLEO  FROM  FTPFLD  TO  PRINT  PRESSURE  FIELD  ADJUSTMENT  RESULT 


5 


DIMENSION  PRLAB!50),PRDSD!50),TARD!50),PIND(50) 
DIMENSION  X!3,l) »R! 3, 3, 1) , ALAB 12, 1) ,C <3, II , TITLE ( 3» 


ID 


15 


LEVEL  2,X,R,ALA8,C 
C 

COMMQN/TPINOX/IT,IP 
C  /TPINDX/  IS  SET  BY  FTPFLO 

C  TIME-X(IT)  ,  OVER PRES SUREaXIIP)»  DISTANCED! 31 
C 

KH  >0  S  KHIS-1 
DO  200  KAal,NR 
KH«KH*1 

C  KH  COUNTS  OBSERVATION  SETS  WITHIN  THIS  HISTORY 
IF!M0D!KH,40).NE.l)  GOTO  28 


20 


25 


30 


35 


40 


45 


50 


55 


PRINT  10, ( TITLE! J), J- 1, 3 ) ,PRDS OIKHIS ) » P INOi KHIS ) , T ARDIKHIS ) 

10  FORMAT! 1H1,/1H  , 15X,5HEVENT, 5X, 3A10, 40X, 21HHI STORY  DISTANCE  -  , 
A  1  PE  10*  3, 3H  M,/,1H  , 15X, 5( 1H-) ,75X, 21HSH0CK  OVERPRESSURE  >  , 

B  1PE10.3»4H  PA, / , 1H  ,  95X,21HSH0CK  ARRIVAL  TINE  •  ,1PE10.3, 

C  3H  S) 

PRINT  15 

15  FORM  AT ! 1H  ,/,lH  ,40X, 31HJ0INT  FITTING  OF  ALL  SPECIFIED  , 

A  22H0VERPRESSURE  HISTORIES,/) 

PRINT  20 

20  FORMAT! 1H  , 26X, 3!5X, 8 HOBS ER VED, 4X,BHSTANDARD, 3X»  8HL  S  T.  SO.),/ 

A  1H  , 2X,2HNR, 10X, 6HL ABELS, 13X, 4HTIME, 7X, 5HERRQR, 4X, 

B  10HC0RRECTI0N, 2X,12H OVER  PRESS URE,3X,5H ERROR, 4X, 10HC0RRECT ION, 

C  4X,  8H0ISTANCE,5X, 5HE RROR, 4X, 1 OHCORRECTION) 

IF!SCTIM»EQ«1«) PRINT  21 

21  FORMAT! 1H  , 34X, 3H! S ) , 8X, 3H! S ) , 8X, 3H! S ) ) 

IFISCTIM.NE.1.IPRINT  22 

22  FORMAT ( 1H  , 33X, 5H! SCT )>6X, 5H! SCT ) ,6X, 5H! SCT  )  ) 

IF1SCPRE.E0.1.IPRINT  23 

23  FORMAT! 1H+, 68X,4H! PA) ,8X,4H!PA),7X,4H(PA>) 

IF!SCPRE.NE.1.)PRINT  24 

24  FORMAT I1H-»,69X,5H(SCP),6X,5H!SCP),6X,5H!SCP)) 

IFISCDIS.EQ.l. ) PRINT  25 

25  F0RMAT!lHt,105X,3HIM),9X,3HIM),7X,3H!M)) 

IF(SCDIS.NE.1.)PRINT  26 

26  FORM  AT ! 1H+, 104X, 5H!SCD),7X,5H!SCD),6X,5HISCD)) 

C  THIS  PRINTEO  HEADLINE*  NEXT  PRINT  A  OATA  LINE 
28  R1»S9RT!RIIT,IT,KA)) 

R2-S0RTIR! IP,IP,KA) ) 

R3«SQRT!R! 3,3,KA) ) 

I F (M 00 ( KH- 1, 5 ) .E Q . 0 )  PRINT  30 
30  FORMAT! 1H  ) 

PRINT  40,KA, ALAB (1,KA),ALAB(2,KA),X!IT,KA),R1,  C ( IT, KA ) , 

A  X!IP,KA),R2,  C!IP,KA),XI3,KA),R3,  C!3,KA) 

40  FORMAT! 1H  , I4,2X, 2A10, IP, 3! 3X, Ell .4, IX, E10. 3, IX, E10. 3 ) ) 

IF!K A.EO.NR)  GOTO  55 

IF!ALABil,KA).EQ.ALAB!l,KA*l> )  GOTO  50 
KHIS«KHIS»1 


H  3 


C  KH IS  COUNTS  HISTORIES 
KH-0 

oO  GOTO  55 

50  IF(M00<KH,40).NE.0I  GOTO  200 

55  IF<SCTIN.EQ.l..AND.SCPRE.E0.1..AND.SCDIS.EQ.l. »GOTQ  200 
PRINT  65,SCTIM, SCPRE, SCDIS 

65  65  FORMAT ( 1H  ,//, 1H  ,31X,31HTHE  DATA  ARE  SCALED  AS  F0LL0WS:»5X, 

A  16HTIME  SC T  -  ,IPE12.5,3H  S»7»1H  ,6?X, 

B  16HPRE SSURE  SCP  ■  ,1PE12.5,4H  PA,/,1H  ,67 X, 

C  16H DISTANCE  SCO  -  ,1PE12.5,3H  Ml 

70  200  CONTINUE 

RETURN 
END 


1AA 
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SUBROUTINE  PLTLOC(PRDS»TAR»TENO»NRPROF»PAR»VPAR»NP» 

A  SCDIS,SCPRES»SCTIME  , SHOCK , T ITLE  ) 

C  THIS  ROUTINE  PLOTS  IN  THE  X,  T-PL ANE  THE  SHOCK  TRAJECTORY,  THE 
C  LOCATIONS  OF  OBSERVEO  HISTORIES  AND  SOME  STREAMLINES. 

C 

C  PROS ( 50 )  ■  HISTORY  DISTANCES 

C  TAR( 50)  *  SHOCK  ARRIVAL  TINES 

C  TEND ( 50 )  •  HISTORY  END  TINES 

C  NRPROF  *  NUMBER  OF  HISTORIES  OBSERVED 

C  PARI  10)  >  PRESSURE  FIELD  PARAMETERS 

C  VP AR( 10, 10)  *  VARIANCE-COVARIANCE  MATRIX  OF  PAR 

C  NP  •  NUMBER  OF  PRESSURE  FIELD  PARAMETERS 

C  SCDIS,  SCPRE,  SCTIME  -  PRESSURE,  DISTANCE  AND  TIME  SCALE 

C  SHOCK  -  SUBROUTINE  THAT  COMPUTES  SHOCK  IIN  SI  UNUTS) 

C  TITLE (3)  •  NAME  OF  EVENT  TO  BE  USED  ON  PLOTS 

C 

COMMON /AMBCHAZ  AIRPR, AIRTEN,AI R6AM, AIRNOL, CHAR VO, CH AREN 
DIMENSION  PR0S(50),TAR(50),TENDI50),TEMP(8),TITLEI3) 
DIMENSION  XSHI100),YSH(100),X(3),Y(3) 

DIMENSION  PAR(10),VPARtl0,10l»  SOL  IN (6 ) , VSOL ( 6, 6, 100) 
DIMENSION  STRMI 6,100) 

DIMENSION  XPP(10),UPPt 10) ,UPTP <10 ), OP  IN (10) , TP  IN (10 ) 

COMMON /CSC  ALE/SC0I,SCPR, SCTI 

EXTERNAL  PFIELD 

COMMON /PLOT/DUM( 6), PLABLI A) 

C 

SCDI-SCDIS  %  SCPR-SCPRES  S  SCTI-SCTIME 
RIN-PRDS(l)  t  R-PRDS(l)  $  TMAX*TEND(1)  S  TMIN-TAR(l) 

00  5  KA-2, NRPROF 
RIN* AMIN1(  PROS(KA)»RIN) 

R»AMAX1(PR0S(KA),R) 

TMIN-AMIN1(TAR(KA),TMIN) 

TMAX«AMAX1(TEND(KA),TMAX) 

5  CONTINUE 

NEXT  COMPUTE  SHOCK  TRAJECTORY 

RMIN-RIN 
RMAX-R 

OELR*(RMAX— RMIN) /99. 

00  10  KA«1, 100 
R1»RMIN>FL0AT(KA-L)*DELR 
RIN0IM*R1«SC0IS 
XSH(KA)«R1 

CALL  SHOCK ( RINDIM, TOI M,POVDIM, USDIM,UPDIN,RHODIM,LBAD ) 
IF(LBAO.EQ.O)  GO  TO  12 
NB  AD>  LB  AD 
PRINT  1A,NB AD 

1A  FORM  AT ( 1H  »*RETURN  FROM  PLTLOC  1A  WITH  NBAD"  P,I10) 

12  CONTINUE 

YSH(KA)-TDIM/SCTIME 
10  CONTINUE 

NEXT  PLOT  SHOCK  TRAJECTORY  AND  LABEL  AXES 

CALL  PLTBEG(8.7,U.2,1.0,13,PLABL) 

CALL  FIXSCA(XSH,100,5.0,XS,XMIN,XMAX,DX) 


n  no  o  o  o 


X  ( 1 )  -RMIN-0.02MRMAX-RMIN) 

X(2)«RMAX»0.02*(RMAX-RMIN) 

X ( 3 ) -RMIN* 1*01 

CALL  C0NSCA(X,3»5.0»XS,XMIN»XMAX,DX) 

CALL  FIXSCA(YSH»100»4.0»YS»YMIN, YMAX»DYI 
Y ( II -TM IN-0.02* (TMAX-TMIN) 

Y ( 2) -TM AX* 0.02* (TMAX-TMIN) 

CALL  C0NSCA(Y»2»4.0»YS,YMIN,YMAX»DY) 

CALL  PLTSCA(2.5»4.0»XMIN»YMIN» XS,YS) 

CALL  PLTAXS(DX»DY»XHIN»XHAX»YMIN»YMAX»4I 
CALL  LABAX(DX,2*0*DY,XMIN,XMAX,YMIN,YHAX) 

CALL  PLTWND(XMIN,XMAX»YMIN, YMAX) 
TX-(XMAX*XMINI*0.5-15.0*0.1*XS 
TY»YMAX*0.5*YS 
ENCODE! 80, 15, TEMP) TITLE 
15  FORM  AT! 3A10»1H>  > 

CALL  PLTSYM(0.1,TEMP,0.0»TX,TY) 

ENCODE (80, 20, TEMP) 

20  FORMAT (13HDISTANCE  (M)>l 

IF(SCDIS.NE.1.0)ENCODE(80,21,TEMP) 

21  FORMAT! 15HDISTANCE  ( S  CD  I  >  » 

TX«( XMAX*XMIN)*0.5-6. 0*0. 1*XS 
TY-YMIN-0.5*YS 

CALL  PLTSYN(0. 1, TEMP, 0.0, TX,TYI 
ENCODE! 80, 30, TEMP) 

30  FORMAT ( 9HTI ME  (S)>) 

I F (SC TIME. NE. 1.0)  ENC ODE ( 80, 31 , TEMP ) 

31  FORMAT! 11HTIME  (SCTI>) 

TX-XMIN-0.7*XS 

TY-! YM IN* YMAX  1*0 .5— 4. 0*0.1*YS 
CALL  PLTSYM(0.1» TEMP, 90.0, TX,TY) 

CALL  PLTDTS!1»0»  XSH, Y SH, 100, 0) 

NEXT  PLOT  HISTORY  LOCATIONS 

DO  40  KA-1»NRPR0F 
X(1I«PRDS(KA) 

X(2)-X(l)  $  X ( 3 ) *  X ( 1 ) 

Y  ( II  -T  AR(  K  A  > 

Y( 2) -TEND(KA)  *  Y(3)«Y( 1) 

CALL  PLTDTS(1»0»X»Y»3»0I 
40  CONTINUE 

NEXT  COMPUTE  ANO  PLOT  STREAMLINES 

AIRPRSC-AIRPR/SCPRES 
0R-0.2MR-RIN) 

DO  1000  1-1,5 
C  IN  THIS  LOOP  COMPUTE  5  STREAMLINES 
D-RIN*0R*(I-1) 

SOL IN! 31-D 

CALL  STR8EG(S0LIN,TPIN,XPP,UPP,UPTP,DPIN,LBAD) 
IF(LBAD.EO.O)  GO  TO  700 
NB AD-LB AD *100 
PRINT  690, NBAD 

690  FORMAT ( 1H  ,*ERROR  RETURN  IN  PLTLOC  690  WITH  NBAD-  *,1101 
GOTO  1000 
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700  CONTINUE 
NSTNAX-100 

OELTS T* CTNAX-SOL INC  II  1/80. 

C  THERE  WILL  BE  AT  LEAST  NSTNAX/2  NODES.  NORNALLY  THERE  WILL  BE  60  TO 
120  C  WITH  THIS  OELTST 

CALL  STRL IN ( TNAX*  AIRPRSC*  AIRGAN*  PFI ELD»PAR»VPAR»NP»SOLIN»TPIN» 

1  XPP>UPP»UPTP»DPIN»OELTST»STRN»VSOL»NSTMAX»LBAD) 

IFCLBAD.EQ.O)  60  TO  900 
NB AO* LB AD +300 

125  PRINT  290.NBA0 

290  F0RNATC1H  » TERROR  RETURN  IN  PLTLOC  290  WITH  NBAD*  *>110) 
IFCNSTNAX.LE.il  GOTO  1000 


130 


135 


900  DO  70  KA*1»  NSTNAX 
XSHCKA)*STRNC3»KA) 

YSHC  K A) *STRNC 1»K Al 
IF (KA.LT. NSTNAX/2)  GOTO  70 

SO«C  XSHCKAI-XSHCKA-l) l/CYSHCKAI-YSHCKA-ll I- 
A  ( XSHC KA— 1 1— XSHC KA— 2 1  I /C YSH CKA— II— YSHCKA— 21 1 
IFCSD.GT.O. I  GOTO  7* 

C  THIS  TESTS  FOR  POSITIVE  CURVATURE  OF  STREANLINE  AND  PREVENTS 
C  THE  PLOTTING  OF  NONSENSICAL  TAIL  OF  STREANLINE 
70  CONTINUE 


1 AO  GOTO  75 

74  NSTN AX*KA 

75  CALL  PLTDTS  C1»0» XSH» YSH»NSTNAX>0) 
1000  CONTINUE 

CALL  PLTPGE 

145  RETURN 

END 


147 
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SUBROUTINE  S TRB E G ( SOL  IN,  TPIN,XPP,UPP»UPTP,DP IN.NBAD) 


5 
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C 

C  THIS  COMPUTES  THE  INITIAL  STREAMLINE  NODE  ON  THE  SHOCK  AND  ITS 
C  ACCURACY.  THE  SOLIN  COMPONENTS  ARE 
C  (T,  P,  R,  U,  RHO,  U**2*RH0/2> 

C  THE  GIVEN  ARGUMENT  IS  THE  SHOCK  DISTANCE  R-S0LINI3). 

C  R  IS  ASSUMED  TO  BE  CONSISTENT  WITH  THE  SCALES  IN  /CSCALE/ 

C  TPIN»XPP»UPP»UPTP  AND  DPIN  ARE  INITIAL  STREAMLINE  VARIABLE 
C  DERIVATIVES  WITH  RESPECT  TO  THE  PARAMETERS 
C 

C  ROUT INR  USES  F2SHCK 
C 

DIMENSION  S0LIN(6)»TPIN(10)  , XPP( 10) , UPP ( 10 ) , UPTP < 10) , DPINl 1 0 ) 

DIMENSION  X(5»1)»PAR(10)»FX(5)»FP(10)»FXXC5»5)»FXP(5»10)» 

A  FPP(10»10)»S0LMAT(6»4),SCALE(4) 

C 

CQHMON/C$CALE/SCO»SCP,SCT 

C0MM0N/CF2DER/GAMCAP,SNDSPD»CPAR(4)»ALQW>SCDC»SCPC»SCTC 
COMMON/AMBCHA/PZ, TZ»GZ,AMZ»  VCH, ENCH, HCH, EHCH 
COMMON /CQMSHK/NP  S»  PARS<4),VPARS (4»4)»SCDS, SCPS, SCTS 
C 

DO  25  KA  » 1 »  3 

25  SCALE (KA)-(SCPS/$CP)*(SCDS/SCD)**KA 

SCALE(4)-SCTS/SCT 

DO  45  KA-1,4  S  P AR { KA ) *  SC AL E ( KA ) * P ARS ( K A ) 

45  CPAR(KA)«PAR(KA) 

C  THE  NEW  PARAMETERS  ARE  SCALED  ACCORDING  TO  /CSCALE/ 

C 

SNOSPD«SNDSPO*(SCT/SCTC)*(SCDC/SCD) 

GAMCAP«GAMCAP*(SCP/SCPC) 

ALOW-ALOWMSCDC/SCD) 

SC  DC  *  SC  D  %  SCPC-SCP  l  SCTC-SCT 
C  THIS  TRANSFORMED  /CF20ER/  INTO  /CSCALE/  UNITS 
C 

R«S0LIN<3) 

C  NEXT  COMPUTE  SHOCK  ARRIVAL  TIME 

X<1,1)«0.  t  X(2,1)»R  $  X ( 3  » 1 ) -0  • 

CALL  F2SHCK(X»1»PAR»F»FX»FP»FXX»FXP»FPP»NBA0) 

IF(NBAD.NE.O)  RETURN 
C 

P0V»< (PAR(3)/R»PAR(2) )/R*PAR(l))/R 
USH«SNDSPD*SQRT( 1. ♦GAMCAP*POV) 

C  SHOCK  VELOCITY 

ROSI«( ANZ/8.3143)*(PZ/TZ> 

C  ROSI  IS  AMBIENT  DENSITY  IN  SI  UNITS 
RAMB-R0SI*(SCD/SCT)**2/SCP 
C  AMBIENT  DENSITY  IN  /CSCALE/  UNITS 
C 

UPSH«POV/(RAMB*USH) 

C  PARTICLE  VELOCITY  AT  THE  SHOCK 

GANTIL»<(GZ-1.)/(2.*GZ*PZ))*SCP 
ROSH-RAMBM  l.+GAMCAP*POV> /( l.*GAMTIL*POV) 

C  DENSITY  AT  THE  SHOCK 

0PSH-UPSH**2*R0SH*0.5 

C  OYNAMIC  PRESSURE  AT  THE  SHOCK  (-SPECIFIC  KINETIC  ENERGY) 
S0LIN(1)«F/SNDSPD 
SOLI N ( 2 )-P0 V 


S0LIN(A>-UPSH 
SOLINC  51-ROSH 
S0LIN(6)-0PSH 
C 

C  NEXT  COMPUTE  INFLUENCE  MATRIX  SOLHAT  WHICH  EXPRESSES  THE 
C  RELATION  BETWEEN  SOLIN  AND  THE  PARAMETER  VARIANCES  VPARS 
DUN-1. ♦GANCAPPPOV 

UPFACT«UPSH*(1./P0V-0.5*GANCAP/DUN> 

ROFAC  T-l. / ( $NDSP0**2*DUN* (1. *G ANTILPPOV ) ) 

DPFACT- <UPSH**2*RQFAC T*2.*UPSHPRQSHPUPFACT>*0. 5 
00  65  KA-1#  3 

65  SOLNAT (2.KAI-1. /R**KA 

SOLN AT ( Zt 4  )-0. 

DO  75  K A- 1»  4 

SOLM AT ( 1»K A )-FP( KA) /SNDSPD 
SOLNAT ( 3» KAI-O. 

S0LNAT(4»KA)«UPFACT*S0LNAT(2»KA) 

SOLN AT { 5»K  A l-ROFACT*SOLNAT ( 2*  K A) 

75  SOLN AT ( 6»KA )-0PF ACT*$  OLNAT ( 2»K A) 

C 

DO  105  KA-1»10  t  XPPI KAI-0  %  UPP(KA>-0  S  TPIN(KA)»0  $  DPIN(KA)-0 
105  UPTPCKAI-0 

POVR  —  <  (3.*PAR(3)/R'*2.*PAR(2)  )/R*PAR(l)  )/R**2 
UPT—  POVR/ROSH 

C  DU/DT  OF  PARTICLE  VELOCITY  AT  SHOCK 
DO  115  KA-1#3 
T  PIN ( KA*5 ) -SOLNAT ( 1»K A ) 

DPINIKA*5)MR0FACT/R0SH-1./IGZ*IP0V*PZ/SCP)  >>*S0LNAT(2»KA) 
UPP(KA*5> -SOLNAT! 4*KA» 

115  UPTP(KA45l-UPT*<-S0LNATI5»KA>/R0SH*FL0AT(-KAI/CR**(KA*l>*P0VRn 
TPIN  <  9 ) -S0LMAT( 1 #4) 

RETURN 
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SUBROUTINE  SHODER!  R»T»TR»TP»TRR»TRP»TPP» 

APQV, PR, PP, PRR,PRP,PPP,NBAD> 

C  THIS  COMPUTES  FOR  GIVEN  DISTANCE  R  THE  CORRESPONDING 
C  SHOCK  TIME  T  AND  OVERPRESSURE  POV,  AND  DERIVATIVES 
C  SUBROUTINE  USES  F2SHCK  TO  COMPUTE  SHOCK  ARRIVAL  TIME 
C  ALL  ARGUMENTS  ARE  ASSUMED  TO  BE  IN  SI  UNITS 
C 

DIMENSION  TPI 10  )  »  TR  PI 10) » TP P( 1 0, 10) ,PPI10 ) , PRP ( 1 0) , PPP( 10, 10> , 

A  SPARI10)»XI5»1),FX|5)»FPI10)»FXXI5,5)»FXPI5»10),FPPI10»10 

C 

COHNON/C0NSHK/NPS»PARSHI4),VPARSHI4,4),SCDIS»SCPRE,SCTIM 
C0MMQN/CF2DER/GAMCAP, SNDS PD, PR  SC  4 ) , ALOW, SCD,SC P, SCT 
GAMC AP-GAMC AP/SCP  *  SNDSPD«SNDSPD*SCD/SCT  *  ALOW-ALOW^SCO 
SCD-1.  $  SCP-1.  *  SCT* 1. 

C  THIS  CHANGED  /CF2DER/  TO  SI  UNITS 
IFINPS.GE.0.AND.NPS.LE.5)G0T0  15 
C  THIS  IS  CODED  FOR  NPS  «  NUMBER  OF  SHOCK  PARAMETERS  *  4 
NBAD* I ABS ( NPS )  $  RETURN 
25  NBAD*25 

PRINT  2  7,  NBAD 

27  FORMAT ( 1H  , 4RETURN  FROM  SHODER  WITH  NBAD*  A, 15) 

RETURN 

C 

15  IF(R.LE.O.)GOTO  25 

NBAO-O 

IF(NPS.EQ.O)GOTO  55 

C 

C  NOW  COMPUTE  SHOCK  OVERPRESSURE  IN  PASCALS  BY  3-PARAMETER  FORMULA 
DO  35  KA* 1, 3 

35  SPAR(KAI-PARSH(KA)*SCPRE*SCDIS**KA 

SPARI4)«PARSHI4)*SCTIM 

C  SPAR  IS  FOR  COMPUTATION  OF  POV  IN  PASCALS  WHEN  R  IS  IN  METRES 
C 

POV*  IIS  PARI3)/R*SPAR  121)7  R+SPARI1M/R 
PR  —  <  (SPAR  I3)*3./R»SPAR!2  1*2.  )/R*SP  ARID  >/R4*2 
PRR*< (SPAR) 3)*12./R+SPARI2)*6. )  7R+SPAR 1 1 >*2 . ) /R**3 
C 

DO  37  K A* 1 , 10  *  PPIKA ) *0  $  PRPCKA)*0 

TP  IK  A ) *0  \  TRP|KA)-0 

DO  37  KB* 1, 10  $  TPP(KA,KB>*0 

37  P  PPI KA, KB ) * 0 
C 

C  ASSUME  THAT  SHOCK  PARAMETERS  ARE  NR.  6, 7, 8, 9. 

PPI6 ) *1  ./R  $  PPI  7 ) -PP ( 6) /R  %  PPC8)-PP17)/R 
PRPC  6)— PPI  7)  S  PRPI7)— 2.4PPI8I  %  PRPI8)—3.*PPI8)/R 
C  NEXT  COMPUTE  SHOCK  ARRIVAL  TIME.  XI 1 > -PRESSURE,  XI3I-TIME 
XI1,1)«0  *  X  (  2,  1 )  *R  $  X(  3,1)*0 
CALL  F2SHCK(X,1,SPAR, F,F X,FP»F XX,FXP, FPP, NB AD ) 

C 

IF(NB AD.EO.O)  GO  TO  40 
PRINT  38,  NBAO 

38  FORMAT) 1H  , 4RETURN  FROM  SHODER  AFTER  F2SHCK  WITH  NBAD-  *,I5) 

GO  TO  55 

40  T*F/ SNDSPD  $  TR-FX ( 2 ) /SNDSP D  S  TRR*FXX( 2, 2) /SNDSPD 
C 

DO  45  KA«1,NPS  S  TP I 5 +K A ) -F PI K A) /SNDSPD 
TRPI 5*KA) - F XP (2, KA) /SNDSPD 
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DO  45  KB«1»NPS 

45  T PP( 5*KA»5>KB)«FPP(KA»KBI /SNOSPD 

55  CONTINUE 
RETURN 
END 


SUBROUTINE  F2SHCKCXX.KA.PAR.F.FX.FP.FXX.FXP.FPP.N8ADI 
C  THIS  IS  SECOND  CONSTRAINT  COMPONENT  FOR  SHOCK  FITTING 
C 

DIMENSION  XX(5,100I,PAR(10),FX (5 1 »FP( 10I.FXXC 5* 5 I.FXP ( 5* IO> . 
A  FPPC 10.10), SFC9) 

EXTERNAL  F20ER 

C  ONMON/CF  20ER/GAMC AP»  SNDSPD,CPAR(4)»ALQW»SCD»SCP»SCT 
C  GAMCAP- C  (l.*GAM»/(2.*GAMn*(SCPR/ AMBPRI 
C  GAMCAP,  SNDSPD  ANO  ALOW  ARE  SET  BV  SUBROUTINE  SCALSH 
C 

DO  15  K8-1.4 
15  CPARCKBI-PARCKBI 

C  THE  PARAMETERS  CPAR  WILL  BE  USED  BY  SUBROUTINE  F20ER 
XSXX (2.KA I 

DO  25  KB*1»  3  $  DO  25  KC-1,3 
25  F  XX( KB, KC I *0 

IF (X • GT.l . E-30)  GOTO  35  S  NBAD-1  S  RETURN 
C 

35  NBAD-0 

SQ»1. ♦GAMCAP* f(PAR (3* /X*PAR(2))/X*PAR(1))/X 
IF(SQ.GT. l.E-50  I  GOTO  45  S  NBAD-2  S  RETURN 
45  FXC1I-0.  S  FX(2)*1./SQRT(5Q)  S  FX  C  3 » — SNDSPD 

FXX(2,2)»0. 5*GAMC  AP*F  X  <2 1 *(  ( 3. *PAR<  31 /X*2.*PAR C 2 >  I /X 
A+PARC1) 1/ ( X*X*SQ I 

C  COMPUTE  PARTS  OF  F2  AND  DERIVATIVES  BY  MULTIPLE  QUADRATURE 
CALL  R0MULTCF2DER»ALQW,X»SF»NBA0) 

IF(NBAD.EQ.O)  GOTO  55  $  NBAD-NBAD+10  S  RETURN 
55  F-SF  < 1 1 ♦ < PARC4I-XXC3, KA) I *SNDSPD 

FPC1)*SF(2)  %  FPC2I-SFC3)  $  FPC3I-SFC4)  $  FP(4)-SNDSP0 

FPPC 1,1)«SF(5)  S  FPPC 1.2I-SFC6)  $  FPP C 1 » 3 1 -SF C 7 1 
FPPC2,11«SFC6)  *  FPP( 2, 2  I »SF ( 7 1  »  F PP C 2, 3) «SF C 8  I 
FPPI 3, ll-SF (7)  $  FPPC3,2I«SFC8>  %  F PP C 3, 31 «SF l 9) 

DO  65  KB-1,4  *  FPPC  4, KBI -0  *  FPPCKB.41-0  %  FXPC1.KB1-0 
65  F XP( 3»KB) *0 

FXPC2.il— 0.5*GAMCAP*FXC2)/CX*SQ) 

FXPC2,2I»FXPC2,1J/X  S  FXP  C  2 , 3 1  -FXPC  2,  2 1  /  X  t  FXPC2.4I-0 
RETURN 
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SUBROUTINE  F20ER < X# F# NBAD ) 

C  INTEGRAND  FOR  NINE  COMPONENTS  OF  F2  AND  DERIVATIVES 
C  USED  BY  F2SHCK  AS  ARGUMENT  OF  ROMULT 
C 

DIMENSION  FC9) 

C0MN0N/CF2DER/GAMCAP* SNDSPD»  PAR( A) t ALOW# SCO#  SCP»SCT 
C  GAMCAPM <1.*GAM»/<2.*GAN»>*CSCP  / AMBPR ) 

C  GAMCAP,  SNDSPD »  ALOW  AND  SCALES  ARE  SET  BY  SUBROUTINE  SCALSH 
C 

NB AD* 0  $  IF IX.GT.l.E-30)  GOTO  15  $  NB AD* 1  *  RETURN 
C 

15  Y-l./K 

SQ-1 . -#GAMC  AP*C  ( P  ARC 31* Y* PAR (2)  l*Y»PAR(ll)*Y 
I F (S O.GT. 1. E-50  1  GOTO  25  *  NBAD-2  i  RETURN 
C 

C  INTEGRANOS  CORRESPOND  TO  FOLLOWING  QUANTITIES 
C  F»  FPC 1>  #  C2># C 3 >#f PP  Cl#ll » Cl# 21 » C 1# 3I*C  2# 21 #  C 2# 31#  1 3#  31 
25  Fill *1«/SQRT( SOI 

FC2)  —  0.5*GAMCAP*FC1»*Y/SQ 
F ( 31 *FC  21 *Y  *  FC4)*FC 3)*Y 
F(5) ■— 1«5*GAMCAP*FC3I/SQ 

FC6) *FC  5)*Y  *  FC7»-FC6)*Y  %  FC8)*FC7)*Y  $  FC9)-FC8»*Y 

RETURN 

ENO 
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SUBROUTINE  ROHULT(F»A»B»SF»NBAO) 

C  RONBERG  INTEGRATION  OF  A  9-D INENS IONAL  VECTOR  FUNCTION 
C 

DIMENSION  SF(9)»T(9»10»20)»FA(9)»FB(9)»FN(9)»FHt 9)»  CORKHI 9» 10) 
C 

NBAO-O 

CALL  F( A»F A.NBAD )  $  IFCNBAD.NE .0)  RETURN 
CALL  F( B»FB»NBAD)  $  I F (NB AD.NE .0)  RETURN 
DO  1*  KD-1*  9 

14  T(KD»1»1)»(FA(K0)+FB(KD))*0.5 
KH-1  $  KHA-1 

C 

15  DO  16  KD-1»  9 

16  FH(KD ) -0 
DEN«FL0AT(KHA)*2. 

DO  25  KA«1»KHA 

AC-F10AT<1*2*CKHA-KA) l/DEN  S  8C-FL0AT I 2*KA-1 I /DEN 
ARG- AC*A+BC*B 

CALL  F( ARG»  FN»NBAD)  S  IF ( NB AO. NE  •  0)  RETURN 
DO  23  K0*l»  9 
23  FH(KD)»FN(KD)*FN<KD) 

25  CONTINUE 

00  26  KD-1#9  $  FN(KO) -FN(KD) /FLOAT (KRA) 

26  T<K0*l»KN*l)«<T(KDf 1»KH)*FN(K0 ) )*0. 5 
C 

C  THIS  IS  TRAPEZ.  NEXT  CONFUTE  RONBERG 
KN-KN+1  *  KC-1  $  ODEN-1. 

C 

35  KC»KC*1  i  DDEN-DDEN*4. 

DO  37  L-l» 9 

CORKN(  L»KC)*(T(  L*KC— 1 »KH)—TIL*  KC—1»  KN~1 )  I  /  <  DDEN—1.  ) 

37  T(L#KC,KN)«T(L»KC-1»KM)K0RKH(L*KC) 

IF(KC. LT.KH.ANO.KC.LT. 10)  GOTO  35 
C 

IFCKN.GE.3)  GOTO  45  t  KNA-KNA*2  %  GOTO  15 
C  AFTER  THREE  STEFS  TEST  CONVERGENCE 
C 

45  IFIKN.GE.20)  GOTO  56 
C  NAXINUN  OF  20  STEPS  ALLOWED 
C 

DO  53  L-l»  9 

TEST- ABS(CORKH( L>KC ) ) 

C  KC-HINt  KN# 10) 

IFtTEST.LE.l.E— 100)  GOTO  53 
IF(TEST.LE.ABS<T(L#KC#KM))*1.E-10)  GOTO  53 
KHA-KHA*2  $  GOTO  15 
53  CONTINUE 
C 

56  00  58  L-l#  9 
58  SF(L)-T(L#KC»KM ) *f  B-A ) 

RETURN 

END 
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SUBROUTINE  STRL IN ( TMAX, AIRPR, A IRGAM,PFI EID» PAR, VPAR, NP AR» SOL  IN, 

A  TPI N , XFP , UPP,UPTP,DP IN, DT,SLINA,VSLINA, NMAXA, NBAD) 

C  THIS  COMPUTES  A  STREAMLINE  STARTIN6  WITH  SPECIFIED  INITIAL 
C  VALUES  AND  EN 
C 

C  TMAX 
C 

C  AIRPR 
C  AIRGAM 
C  PFIELD 
C  PAR*  VPAR»NPAR 
C  S0LIN(6I 
C 

c 

C  TP  IN (10) 

C  XPP<10) 

C  UPP(IO) 

C  UPTP(IO) 

C  DP  IN ( 10 ) 

C  OT 
C 

C  THE  FOLLOWING  WILL  BE  COMPUTED  BY  THIS  ROUTINE 
C 

C  SL INA(6> NMAXA )  -  FLOW  VARIABLES  ALONG  THE  STREAMLINE  ( T,P,R,U,RH0,UPP2* 

C  VSLINA< 6, 6, NMAXA)-  VARIANCE-COVARIANCE  MATRIX  OF  SLINA 
C  NMAXA  *  MAXIMUM  NUMBER  OF  NODES  IN  SLINE 

C  WILL  BE  REPLACED  BY  ACTUAL  NUMBER  COMPUTED 

C  NB AD  -  ERROR  INDICATOR 

C 

DIMENSION  PAR(10),VPAR(10,10),S0LIN(6),TPIN(10),XPPC10),UPPI10), 

A  UPTP(10),DPIN(10),SLINA(6,100),VSLINA(6,6,100) 

C 

COMMON/ SC RCH3/  X ( 3, 1 ) ,FX ( 31 , FP I 10) , FXPt 3, 10 >, FXX C 3* 3 ), FPP C 10. 10) 

LEVEL  2,X,FX,FP,FXP,FXX,FPP 
COMNON/TPINOX/IT»IP 
C  /TPINDX/  IS  SET  BY  FTPFLD 

C  TIME-X(IT)  >  OVERPRESSURES  (IP) ,  DISTANCE-X(  3) 

C 

DIMENSION  UT(2),XP(2, 10),UTP(2,10)»UP(2»10)»S0LMAT(6,10) 

A,UC2 )»UTT(2),SLINE(6, 51)*VSLINE(6»6»51) 

C  SLINE  AND  VSLINE  ARE  WORKING  AREAS  WITH  LENGTH  NMAX 
DATA  CNHAX-51) 

C 

NBAD-0 

DO  9  K A»1 »  6 

SLINE (K A, 1) •SOLIN(KA) 

9  SLINA(KA, l)-SOLIN(KA) 

IF(NMAXA.GT.2)G0T0  12 
NMAXA-0 

NBAD-U  »  PRINT  11,  NBAO  *  RETURN 

11  F0RMAT(1H0,10X,30HRETURN  FROM  STRLIN  WITH  NBAD  -»I4) 

12  IF(DT.GT.O. )  GOTO  15 
IF(SLINA( 1»1). GE. TMAX)  GOTO  15 
NMAXA-0 

N BAD- 12  t  PRINT  11, NBAD  t  RETURN 
C  OT  IS  PERMITTED  TO  BE  ZERO  FOR  ONE  POINT  STREAMLINE 
15  IF(SOLIN( 3).GT.0. )  GOTO  25 


ING  AT  TMAX 

-  TIME  AT  END  POINT  OF  STREAMLINE.  THE  ACTUAL  TIME 
CAN  BE  BY  DT  LARGER  THAN  TMAX 

-  AMBIENT  PRESSURE 

-  RATIO  OF  SPECIFIC  HEATS 

»  PRESSURE  FIELD  SUBROUTINE 

-  PARAMETERS,  THEIR  VARIANCE  ANO  NUMBER  FOR  PFIELD 

-  INITIAL  VALUES  ON  STREAMLINE,  VIZ. 

TIME,  PRESSURE,  DISTANCE,  VELOCITY,  DENSITY, 
DYNAMIC  PRESSURE  (-  KINETIC  ENERGY  DENSITY) 

-  O/DP AR  OF  THE  INITIAL  TIME 

-  D/DPAR  OF  INITIAL  POSITION 

>  D/DPAR  OF  INITIAL  PARTICLE  VELOCITY 

-  D/OPAR  OF  IN  I TI ALL  PARTICLE  ACCELERATION 

-  O/DPAR  EXPRESSION  NEEEOED  FOR  INTEGRATION  OF  UPP 
•  TIME  INTERVAL  FOR  INTEGRATION 
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C  CHECK  FOR  NEGATIVE  INITIAL  OISTANCE 
NNAXA-0 

NBAO-15  %  PRINT  11,  N BAD  S  RETURN 
25  CONTINUE 

ROZa  SOL  IN  (  5 1  t  GEXP-1 ./AIRGAM  $  PRZ-SOL IN( 2 >*AIRPR 
DO  31  1-1,2 

00  30  KA-1,NPAR  «  XP(I»KA)-XPP(KAI  t  UP  ( I,KA) -UPP (K A I 

30  UTP< I,KA)-UPTP(KA) 

31  CONTINUE 
C 

X(IT,ll«SLINE(l»l)  t  X<IP,ll-0.0  S  X( 3, 1J -SLINE ( 3» 11 
C  TINE  PRESSURE  OISTANCE 

CALL  PFIELD(X»1,PAR,F»FX»FP»FXX#FXP»FPP,LBAD> 

3500  IF(LBAD.EO.O)  GOTO  39 
NMAXA-0 

NBAD-3500+L8A0  $  PRINT  11,  NBAO  S  RETURN 
C 

39  UT(1I  —  FX(  3)*(PRZ/(F*AIRPR>  >**GEXP/ROZ 
C  OU/OT— <OP/OR)*<PO/P>**< 1/GAMMAI/RHOZERO 
U ( 1 I -SLINE (4,1) 

UTT<  l)-UT«l)*<-GEXP*<FXIIT)*Um*FX(3)»/IF+AIRPR) 

A  ♦(FXX(IT,3)>U(1)*FXXC3,3))/FX(3)  ) 

DTSTOR-OT  $  TST0R-SLINAC1»1I*DTST0R  S  KT-1 
C  COHPUTAT ION  RESULTS  WILL  BE  STORED  APROXINATELY  FOR  TSTOR 
C  KT  COUNTS  STORAGE  IN  SLINA  AND  VSLINA 

C  THIS  IS  ACTUAL  INTEGRATION  INTERVAL.  WITH  DTS-0  GET  FIRST  NODE 
DTS-O. 

KA-1 

C 

C  NEXT  STATEMENT  IS  BEGINNING  OF  INTEGRATION  LOOP 

45  SLINE(3*KA+1I-SLINE(3,KA)+DTS*(U(L)+0.5*DTS*(UT(1)+DTS*UTT(1)/3.I) 
C  NEW  OISTANCE  BY  FOURTH  ORDER  FORMULA  IN  DTS 
SLINE <1,KA»11-SLINE(1,KA»40TS 
C  NEW  TIME 

DO  47  KB- 1, NP AR 

47  XP(2,KBI-XP(l,KB)+DTS*(UP(l,KB)*0.5*DTS*UTP(l,KB)l 
C  NEW  DX/DPARAMETER.  THIRD  ORDER  ERROR  IN  DTS 
C 

X ( IT  ,1)-SLINE(1,KA  +  1)  *  X(IP, 11-0.0  %  X(  3,  1 l-SL INE ( 3,K A*1 ) 

CALL  PFIELD(X,1,PAR,F,FX,FP,FXX»FXP»FPP, LB AD) 

IF(LB AD.EO.O)  GOTO  55 
5100  NBAO- 5100+L BAO  *  PRINT  11,  NB AD 
KT-KT— 1  $  GOTO  155 

C 

55  SLINE(2,KA*1)-F 
C  NEW  PRESSURE 

UTC2  I  — FX  <3I*CPRZ/(F*AIRPRI )**GEXP/ROZ 
U(2l«U<m0.5*DTSMUT<l)*UT<2l) 

C  FIRST  APPROXIMATION  OF  NEW  VELOCITY.  THIRD  ORDER  ERROR  IN  DTS 
UTT(2I-UT<  2)*<-GEXP*(FX(ITI*UC2>*FX(3> >/<F*AIRPR) 

A  ♦(FXX(IT,3I*U(2)*FXX(3, 3II/FX(3)  ) 

UC2I  -U<2»»(UTT(1)-UTTI2»)*DTS**2/12. 

C  NEW  VELOCITY.  FIFTH  ORDER  ERROR  IN  DTS 
SLINE (4, K A* II -U (21 
DO  65  KB-1,NPAR 
UTP(2,KB)-UT(2I*(-DPIN(KB) 

A  -(FP(KBI^FX(3)*XP(2,  KB1MGEXP/(F*AIRPR) 
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B  ♦  (FXP<3»KB»*FXX<3«3l*XP(2»KBn/FX<3>  ) 
UP<2»KB)»UP(l>KBI*0.5*0TS*(UTP<l»KB»*UTP(2»KBn 
65  CONTINUE 

C  NEW  DU/DPARAMETER.  THIRD  ORDER  ERROR  IN  DTS 
SLINE(5»KA>1»*R0Z*< IF tAIRPR ) /PRZ > **GEXP 
C  NEW  DENSITY 

SLINE(6/KA*l>-0.5*SLINEC5,KAn>*SlINEI4,KA»l)**2 
C  NEW  DYNAMIC  PRESSURE 
C 

C  NEXT  COMPUTE  VARIANCE  ESTIMATES  OF  SOLUTION 
DO  75  KB«1»  NP AR 
SOLMATIl,KBI«TPIN<KBt 
S  OLM ATI 2»KB )*FP(KB)*FX(3l*XP(2»KB> 

SOLMAT!  3»K8I*XP(2»KB) 

S0LMAT(4*KBI»UP(2»KBI 

S  OLM AT <  5»KB  >*SL INE ( 5»  K A*1 )* I  DP INIK8 ) 

A  46E  XP* (FP  CKB)*FX( 3>»  XPC  2»KBI ♦FX( IT I*S0LMAT(1»  KB  1 1/ ( F*AIRPR I  ) 
SOLMAT  1 6»KB)*0. 5*SL INE (4» KA*1 ) *JSLINE 1 5» KA^l ) * SOLMAT ( 4# KB  >*2. 

A  ♦SLIN£I4»KA*1J*SQLMATI5»KB) ) 

75  CONTINUE 

C  SOLMAT  IS  THE  JACOBIAN  MATRIX  DSLINE/DPARAMETER 
00  95  KB*1>6  $  DO  95  KC-1»6 
VSLINEIKB»KC*KA*l)-0. 

00  85  KD* 1»NPAR  t  DO  85  KE*1»NPAR 
VSLINE(KB,KC»KA*1»-VSLIN£<KB>KC»KA*1»* 

A  SOLMAT (KB»K0)*VPAR(K0»KE )* SOL  MAT (KC.KE ) 

85  CONTINUE 
95  CONTINUE 
C 

C  NOW  STORE  RESULTS  IF  TSTOR  REACHED 
KA-KA+1 

IFIKT.EQ.IIGOTO  97 

IF<SLINE(1,KA).LT.TST0R-DTS*0.2)G0TQ  125 

97  00  99  KB* 1» 6  t  00  98  KC*1»6 

98  VSLINA<KB,KC#KT»*VSLINEtKB>KC#KA) 

99  SLINA(KB,KT»*SLINE(K8,KA) 

C 

IF<SLINA<l,KTI.GE.TMAXIGQTO  155 
C  BRANCH  TO  155  WHEN  END  OF  STREAMLINE  REACHED 
TSTQR*5LINA(1»KT) ♦DTS  TOR 

C  TIME  VALUE  FOR  NEXT  NOOE  TO  BE  STORED  IN  SLINA 
KT*KT*1  S  0TS*DT*0» 2 

C  AFTER  FIRST  NODE  CONTINUE  WITH  DTS.GT.O. 

C 

IF(KT.LT.NMAXA)GOTO  115 
C 

C  THIS  IS  PROGRAMMING  ERROR.  WITH  GIVEN  DT  END  TIME  CANNOT 
C  BE  REACHEO  IN  NMAXA  STEPS.  CORRECT  BY  INCREASING  DT 
0 TSTOR ■ OT S TOR *2. 

C  ELIMINATE  HALF  OF  STORED  RESULTS 
KC-2  *  KB-3 

102  00  104  KD-1»6  *  DO  103  KE*1»6 

103  VSLINAIKD»KE,KC)*VSLINA<KD»KE#KB> 

104  SLINA(KO,KC)*SLINA<KD,KB> 

KC*KC«-1  *  KB*KB*2 
IFIKB.LE. NMAXA) GOTO  102 

KT-KC-1  $  TSTOR "SLINA l 1»KT) ♦DTS TOR 


GOTO  125 
C 

115  IF(KT.LE.2)KA«1 
C 

125  IFCKA.LT.NMAXIGOTO  145 
C 

C  NOW  WORK  AREA  IS  OVERFLOWING.  ELIMINATE  OLD  STUFF 
KC-2  $  KB-3 

131  DO  133  KD-1,6  $  DO  132  KE«1*6 

132  VSLINE(KE»KO»KC)aVSLINE(KEfKD»KB) 

133  SLINE ( KD»  KC )*SLINE (KD»KB ) 

KC-KOl  *  KB*KB*2 
IFCKB.LE.NMAXIGOTO  131 

KA-KC-1  $  IF(KB. EQ.NM AX>1 I  GOTO  45 
C 

C  PREPARE  FOR  NEXT  INTEGRATION  STEP 

145  ll(ll«U(2l  $  UT(  1 1 “UT(  2>  $  UTT(1)-UTT(2) 

DO  148  KB«1»NPAR  l  XP { 1»KB » »XP <2,KB 1  S  UP( 1#KB ) -UP! 2, KB) 
148  UTP(1»KB)-UTP(2»K6) 

GOTO  45 
C 

155  NMAXA-KT 
RETURN 
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SUBROUTINE  OIMFLD!  SCD» SCP.SCT,  EXNU, P»  VP, ERZ,NP» 

A  PDIM,VPDIM, TITLE) 

THIS  COMPUTES  THE  VALUES  OF  PRESSURE  FIELD  PARAMETERS 
AND  OF  CORRESPONDING  VARIANCES  IN  SI  UNITS. 

IT  IS  CALLED  FROM  MAIN  AFTER  PRESSURE  FIELD  ADJUSTMENT  BY  FTPFLD 

DIMENSION  P110), VP!  10, 10),  PD  IMHO), VP0IM1 10,10), TITLE  13) 
DIMENSION  EXNU<3) 

DIMENSION  SCMAT ( 10»10 ), DIM! 10) ,COR! 10>10) 


15 


EX  A»  E  XNU{ 1 

DO  15  KA-1 

SCMAT  ( KA*  K 

FORMATIFA. 

TX-5H/S 

EXA2-EXA-1 

TXa5H/S**2 

EX82-EXB-1 

TX«5H*PA 

EXC2-EXC-1 


)  %  EXBaEXNU12)  t  EXC-EXNU13) 

*10  S  DO  15  KBa 1* 10 

B)*0 

1»A5) 

S  ENCODE (  9»17»DINI1) ) EX  A*  TX 
.  S  ENCOD E (  9* 17, D IM( 2) )  EXA2*TX 
«  ENCODE!  9»17»0IM( 3) )  EXB,TX 
.  i  ENCODE!  9* 17, DIM! A) )  EXB2,TX 
S  ENCODE!  9* 17, DIN! 5  ) )  EXC,TX 
.  $  ENCODE!  9* 17, DIM! 61 )  EXC2»TX 


SCMAT 11,1 >«SCD**EXA/SCT 
SCMAT!2,2)«SCD**!EXA-1. )/SCT 
SCMAT!3,3)»SC0**EXB/SCT**2 
SCMATIA,A)«SC0**!EXB-1.)/SCT**2 
SCMAT! 5,5 )«SCO**EXC*SCP 
SCMAT!6,6)«SC0**!EXC-1.)*SCP 


25 

35 

A5 


DO  A 5  KA-1,NP  $  PDI M ( K A ) » 0 
00  35  KB"1,NP  t  VPDIN ( KA, KB ) a0 
DO  25  KC-1,NP  $  DO  25  K0-1,NP 

VPOI M! KA, KB laVPO IM!KA,KB)+SCMAT(KA»KCI*VP!KC»KD)*SCMAT(KB»KD) 
PDIM!KA)aPOIH!KA)ASCMAT!XA,KB)*PIKB) 

CONTINUE 


PRINT  50, ITITLE1J), J-1,3) 

FORMAT! 1H1, //,1H  , 10X , 5HE VENT, 5X, 3A10, / , 1H  ,10X,5!1H-I) 
PRINT  55 

55  FORMAT! 1H  ,///,lH  , 10 X, 30HD IMENSION AL  VALUES  OF  PRESSURE, 
A  17H  FIELD  PARAMETERS,/) 

PRINT  65 

65  FORMAT! 1H0, 10X, 1 OH  PARAMETERS, 5X, 8 HSTANOARO, 7X , 8HSTANDARD, 
A5X,9H0IMENS ION, /» 1H  , 26X, 6H ERRORS ,7X, 10HERR0RS*ERZ, / ) 

DO  85  K Aa  1  *  NP 

PER-SQRT! VPDIMIKAjKA)  )  $  PE RZa  PER*E RZ 
PRINT  75, PDIM!KA1»PER,PERZ,DIM!KA) 

FORMAT! 1H  ,9X,1PE12.5, 3X, 1PE10.3,AX,IPE10.3,5X,3HM**,A9) 
85  CONTINUE 

PRINT  87, EXA,EXB, EXC 

87  FORMAT  11H  ,//,lH  ,10X»29HTHE  EXPONENTS  IN  THE  PRESSURE, 

A  18H  FIELO  FORMULA  ARE,//,1H  ,10X,AHNA  a,0PF5.2,/, 

B  1H  , 10 X, AHN B  a,0PF5. 2,/,lH  ,10X,AHNC  a,0PF5.2) 


55 


C  NEXT  COMPUTE  AND  PRINT  CORRELATION  MATRIX 
DO  88  K  Aa 1*  NP  S  00  88  KBal,NP 
88  COR!KA,KB)aVP!KA,KB)/SQRT(VP!KA,KA)*VP!KB,KB)) 
PRINT  89 


159 


89  FORMAT  1 1H  #//,lH  , 1  OX > 26HC0RRE L AT IOM  MATRIX  OF  THE  » 
AlOHPARAMETERS ,//» 

DO  91  KA-1,NP 

PRINT  90, ICORIKA, J »,J«1,NP> 

90  FORM  ATI 1H  , 8X,6 ( 2X, OP Fll. 8 )) 

91  CONTINUE 

PRINT  95, EXC»EXA»EXB, EXC 

95  FORMAT (1H0,///,1H  ,10X,3AHTHE  OVERPRESSURE  MODEL  IS  GIVEN  BY,// 
A1H  ,20X,21HP  -  I PSHOCK IR I— P5/R+*, F4» 1, 1H) , 

B  25H  *  EX P I  TAU*IP1*P2*R)/R**,F4.1,3H  ♦  , 

C  20HTAU«2*IP3»P4*R)/R**,F*.1,2H  ),9H  ♦  P5/R**, F4.1, 1H, / /, 

D  1H  , 2 OX, 5HWHERE , 5X, 1 7HTAU  -  T-TSHOCK (R I , // > 

PRINT  105 

105  FORMAT  1 1H  ,//,lH  , 10X, 27HVAR I ANCE-COVARI ANCE  MATRIX  , 

A33HI NOT  INCLUDING  THE  FACTOR  ERZ**2),//> 

DO  125  KA-1,NP 

PRINT  115, I  VP 01 NIK A, J ),J*1,NP) 

115  FORM ATI 1H  , 10X, 61 3X, 1PE12.5 >> 

125  CONTINUE 
PRINT  127 
FORMAT I1H  ,///) 

RETURN  $  END 
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SUBROUTINE  PLTFLD< T IT LE »T ARD, P IND.P AR» VP AR» ER Z» NP.NRPROF » 

C  THIS  ROUTINE  PLOTS  INDIVIDUAL  OVERPRESSURE  HISTORY  OBSERVATIONS 
C  AND  CORRESPONDING  PRESSURE  FIELD  FUNCTION 
C  IT  IS  CALLEO  FROM  FTPFLD  AFTER  ADJUSTMENT 
5 

C  TITLEI3)  -  NAME  OF  THE  EVENT 

C  TARDC50)  «  SHOCK  ARRIVAL  TINES  AT  THE 

C  P INO ( 50 )  «  INITIAL  SHOCK  OVERPRESSURE 

C  PARC  10)  «  PRESSURE  FIELD  PARAMETERS 

10  C  VP  AR ( 10. 10 )  -  VARIANCE-COVARIANCE  MATRIX 

C  ERZ  -  STANOARO  ERROR  WITH  WEIGHT 

C  NP  >  NUMBER  OF  FIELD  PARAMETERS 

C  NR  PROF  »  NUMBER  OF  HISTORIES 

15  C  THE  ROUTINE  USES  PFIELD  TO  COMPUTE  THE  FITTED  PRESSURE 

DIMENSION  TITLE<3),TARD<50>,PINDC50>,PAR(10)»VPAR 110.10) 

COMNON/COMPR/TP(2»5000)»ERTP(2»5000)»AL8(2»5000I»NSET(50I» 

20  A  DISTI50),ERDIST(50) 

LEVEL  2.TP.ERTP.ALB.NSET.DIST. ERDIST 
C  /COMPR/  CONTAINS  INPUT  TIMES  AND  OVERPRESSURES. 

C  NSET  GIVES  THE  NUMBER  OF  SETS  IN  EACH  HISTORY. 

C  0 1  ST  CONTAINS  HISTORY  DISTANCES 
25 

C0MM0N/SCRCH2/X<3.5000)»RI3»3» 50001 .LSTXt 5000 >. XC ( 3,  5000)  . 

A  C ( 3, 50001. WORK < 14307 ).LSTN< 50001 
LEVEL  2.X. R.LSTX.XC.C. WORK. LSTN 
C  FR0M/SCRCH2/QNLY  XC  IS  NEEDED  TO  PLOT 
30  C  THE  CORRECTED  OVERPRESSURES  AND  TIMES 

COMNON/TPINDX/ITC.IPC 
COMMQN/CSC ALE/SC0I.SCPR.SCT1 
C  / T  PI NDX /  AND  /CSCALE/  ARE  USED  BY  PFIELD 
35 

C0MM0N/CPARG/XF(3»1).FX(3).FP(10).FXX(3.3).FXP(3.10).FPP(10.10) 
LEVEL  2»XF,FX,FP»FXX»FXP,FPP 
C  THESE  ARE  ARGUMENTS  OF  PFIELD 

AO  C  OMMON/PLOT /ERF.0(5)»PLABL(4) 

C  /PLOT/  CONTAINS  CONFIDENCE  FACTOR  ERF  AND  PLOTLABEL 

DIMENSION  XP(201).YP(201).RE(2.2).TEXT(10).EPt 201) 

45  IFCERF.LE.0.)ERF«2.0 

CALL  PLTBEG(22*0. 28*5. 0.3937. 13. PLABL) 

C  PLOTTING  SCALES  ARE  IN  CENTIMETRES 

50  KCS-0 

15  00  155  KH-l.NRPROF 

KSET-NSETC KH)  i  IFIKSET.LE.OJGOTO  155 

C  NEXT  FINO  EXTREMA  FOR  A  HISTORY  AND  FIX  SCALES 
55  KINT  »KCS*1 

XP(1 1 *TP( l.KINTI  $  XP ( 2I» XP( 1 1 
XP(1 )-AMINl(XP(l»,TARD(KH>) 


HISTORY  LOCATIONS  (S> 

AT  HISTORY  LOCATIONS  (PAI 

OF  PAR 
ONE 

PAR 


161 


YP!1)«TP!2,KINT>  $  YP(2)»AMAX1(YP<1)»PIND(KHJ> 

00  25  KA»1,KSET 
KCSKC  S+KA 

XP!1)«ANINHXP!1),TP!1,KC>-ERTP11,KC)*ERF) 

XP(2 )-AMAXl!XP!2),TP! 1,KC > *ERTP ! 1,KC ) *ERF ) 
YP!1)«AMIN1!YP!1),TP! 2,KC)-ERTP12,KC)*ERF) 
YP!2)«AMAX1!YPI2),TP!2,KC)*ERTP!2,KC)*ERF) 

25  CONTINUE 

C  NEXT  FIX  SCALES 

XSIZE-12.0  t  YSIZE-10.0 
AUGX-AMAXli XP!2)-XP1 I )* 0.001 )*0. 05 
XP!3)“XP!1 )— AUGX 
XP<4)»XP! 2)*AUGX 

CALL  FIXSCA!XP,4,XSIZE»XS,XMIN,XMAX,DX) 

AUGY  «AMAX1!YP(2)-YP!1)»1.E3)*0.05 
YP!3)*YP!1 )— AUGY 
YP!4)*YP!2) +AUGY 

CALL  FIXSCA!YP»4»YSIZE»YS»YMIN»YMAX»DY) 

CALL  PLTSC A( 6*0* 10.0, XMIN, YNIN, XS, YS> 

CALL  PLTAXSIOX, DY,XMIN,XMAX»YMIN«YMAX,4) 

CALL  LABAX!0X,2.0*DY, XMIN, XMAX, YNIN, YHAX) 

C  NEXT  PLOT  HEADLINE  ETC. 

HT-0.25 

ENCODE ( 80,31,TEXTI 

31  FORMAT (9HTINE  (S»>» 

XT«!  XMIN-*XMAX)*0. 5—4. 0*HT*XS 
YT*YMIN— YS*1.4 

CALL  PLTSYMIHT»TEXT»0.0»XT,YT) 

ENCODE! 80, 32, TEXT) 

32  FORMAT! 18H0VERPRESSURE  !PA)>) 

XT»XMIN-XS*1.8 

YT»1YMIN*YMAX)*0.5-8.5*HT*YS 
CALL  PLTSYHIHT, TEXT,90.0, XT,YT) 

ENCODE !  80,33,TEXT)!TITLEIJ),J*1,3) 

33  FORMAT! 3A10,1H> ) 

XT»!XMIN*XMAX)*0.5-15.0*HT*XS 

YT»YMAX»YS*2.3 

CALL  PLTSYM!HT,TEXT,0.0,XT,  YT) 

YT»YMAX*YS*1.5 

ENCODE ! 80, 34, TEXT) ALB < 1,K INT ) 

34  FORMAT ! A10, 1H>I 

CALL  PLTSYMiHT,TEXT,0.0,XT,YT) 

ENCODE ! 80, 35, TEXT) 

35  FORMAT! 26HFITTED  OVERPRESSURE  FIELD>) 
XT«!XMIN+XMAX)*0.5— 12.5*HT*XS 
YT«YMIN-YS*2.5 

CALL  PLTSYM!HT,TEXT,0.0,XT,YT) 

ENCODE ! 80, 36, TEXT) 

36  FORMAT! 37HC0NFIDENCE  LIMITS  AND  ERROR  ELLIPSES*) 
XT»XMIN 

YT«YMIN-YS*4.0 

CALL  PLTSYM!HT,TEXT,0.0, XT,YT) 

ENCODE! 80, 37, TEXT ) ERF 

37  FORM  AT! 14 HCOR RES  POND  TO  ,0PF5.2,17H  STANDARD  ERRORS*) 


YT»YT-2.0*HT*YS 

CALL  PLTSYM(HT,TEXT,0.0,XT,  YT) 

ENC0DE(80,38,TEXT)ERZ 

38  FORMAT ( 16HTHE  FACTOR  ERZ  »,1PE9.2,17H  IS  NOT  INCLUOEO>) 
YT«YT-4.0*HT*YS 

CALL  PLTSYM(HT,TEXT,0.0,XT,YT) 

ENCODE! 80 ,39, TE XT) 

39  FORMAT ( 23HIN  THE  ERROR  ESTIMATES*) 

YT»YT-2.0*HT*YS 

CALL  PLTSYM<HT,TEXt,0.0,XT,  YT) 

CALL  PLTWND(XMIN»XNAX»YMIN»YMAX) 

C  NEXT  PLOT  ALL  OBSERVATIONS  WITH  ERROR  ELLIPSES 
DO  45  KA«1,KSET 
KC»KCS*KA 

TC*TP<1,KC)  $  PC«TP(2,KC> 

CALL  PLTDTS(3,1»TC,PC,1,0) 

C  THIS  PLOTTED  DATA  POINT 

XP<1)»TP< 1,KC)  %  XP(2)“XC(ITC*KC)*SCTI 
YP (1 ) *TP( 2»KC )  i  YP(2 )»XC( IPC»KC)*SCPR 
CALL  PLTDTS<1»0»XP»YP»2»0) 

C  THIS  PLOTTED  CONNECTION  TO  CORRECTED  DATUM 
RE{1»1)*ERTP(1»KC)**2 
RE<2,2)«ERTP<2,KC)**2 
RE(1,2)«0.  S  RE  ( 2, 1 ) "0. 

CALL  ERELCM(TC»PC»RE»ERF»XP»YP) 

C  THIS  COMPUTEO  THE  ERROR  ELLIPSE 
CALL  PLT0TS<1,0,XP,YP, 201,0) 

C  THIS  PLOTTED  THE  ERROR  ELLIPSE 
45  CONTINUE 

XP(1)«XMIN  %  XP(2)«TARD(KH)  $  XP(3)-XP(2) 

YPCD-0.0  $  YP(  2  )  «*0. 0  %  YPt  3  )  *PIND(  KH  ) 

CALL  PLTDTS<1,0,XP,YP,3,0) 

C  THIS  PLOTTED  PRESSURE  AHEAD  OF  SHOCK  AND  INITIAL  PRESSURE 

C  NEXT  COMPUTE  FITTED  CURVE 
DO  75  K  A*  1 , 2 0 1 

XP(KA)«TARO<KH)MXHAX-TARD(KH)  ) AFLOAT (KA-1) /200. 

XF(ITC,1)-XP(KA)/SCTI 

XF(IPC,l)-0. 

XF<3»1)-DIST(KH)/SCDI 

C  PFIELO  PARAMETERS  ARE  SET  FOR  SCALEO  CALCULATIONS, 

C  THEREFORE  INPUT  MUST  BE  SCALED,  TOO 

CALL  PFIELO(XF,l,PAR,F,FX,FP,FXX,FXP,FPP,NBAD) 
IF(NBAD.EQ.O)GOTO  63  *  F-0. 

00  61  K  B*  1 ,  NP 
61  FP(KBJ»0. 

63  YP(KA)«F*SCPR 

C  YP  IS  OVERPRESSURE  IN  PASCALS 
E  P (K  A  )  ■ 0 

DO  65  KPA *  1 , NP  1  DO  65  KPB«1»NP 
65  EP(KA)-EP(KA)tFPCKPA)*VPAR(KPA,KPB)*FP!KPB) 

EP(KA)-SQRT( ABS(EP(KA) ))*SCPR 
75  CONTINUE 
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CALL  PLTDTSI1»0,XP»YP,201»0) 
C  THIS  PLOTTED  THE  FITTED  FIELD 

DO  85  KA-1,201 
85  YP<KA)«YP(KA)+EP<KA)*ERF 

CALL  PLTDTS(1»0»XP»YP* 201 » 01 
DO  95  KA-1>201 

95  YP(KA)«VP<KA)-2.*EP(KA)*ERF 
CALL  PLTDTS<1*0,XP,YP#201,0> 
C  THIS  PLOTTED  CONFIDENCE  LIMITS 


CALL  PLTPGE 

185  C  PLOTTING  COMPLETED.  REPEAT  FOR  NEXT  HISTORY 

KCS-KCS+KSET 


155  CONTINUE 

C  END  OF  LOOP  15-155  OVER  ALL  HISTORIES 

190 

RETURN 

END 


L  EXCEEDS  131*071  WORDS  (LCM-I  REQUIRED) 


oooooooooooooo 


SUBROUTINE  COLS  AC  A(  X,  R  ,  AL  AB  EL  *  LS  TX»  NX*  NSET*  P  AR  ,  NP ,  FU*  I  T  V  P>.  . 

A  X  C*  C  *  L  ST  N > NRGD* ERZ*V,ERP>LBAD,NXD»NPD,W*NW) 

LEAST  SQUARES  ROUTINE  FOR  CORRELATED  DATA  AND  SCALAR  CONSTRAIN fS 

IN  THIS  ROUTINE  COMPUTE  ADDRESSES  IN  THE  WORK  AREA  W(NW)  AND  THEN 
CALL  COLSACB  WITH  CORRESPONDING  ARGUMENTS 

THE  DIMENSION  NW  OF  THE  WORK  AREA  W  MUST  BE  LARGER  OR  EQUAL  T3 

NX* ( 1+NX) *2  ♦  NX*NP*4  ♦  NP*(]>NP»*8  ♦ 

♦  NXD* ( 1*NXD )  NXD*NPD  ♦  NPD*I1*NPD>  ♦ 

♦  NR*(1*NX*NX*NX>  ♦  MAXO(NX*( 3*NX)»NP*{  3*NP  ) ) 

FOR  DOUBLE  PRECISION  CALCULATIONS  THE  REQUIRED  WORK  AREA  IS 

NX* (1*NX)*4  ♦  NX*NP*8  ♦  NP* < 1 5*18*NP )  ♦ 

♦  NXD*(1*NXD»  ♦  NXD*NPD  *  NPD*(1*NPD>  ♦ 

♦  NR* <1*NX*2*NX*NX)  ♦  M AXO ( NX* ( 3+NX ) »NP* I 3*NP )) *2 

THE  MEANINGS  OF  ALL  OTHER  ARGUMENTS  ARE  GIVEN  IN  COLSACB 
DIMENSION  W(l) 

LEVEL  2,X,R*ALABEL»LSTX,XC»C,W,LSTN 
EXTERNAL  NTRINOB* MTRINVB 
DATA! 1*21 

C  1*1  FOR  SINGLE  PRECISION  COMPUTING 
C  1*2  FOR  DOUBLE  PRECISION  COMPUTING 

KFP*NXD*1  $  KFXX«KFP*NPD  $  K FXP*KFX X*NXD* NX D 
KFPP*KFXP*NXD*NPDJ  KR INV* KF PP*NPD*NPD 
C  ASSUME  THAT  CONSTRAINT  SUBROUTINE  IS  CODED  FOR 
C  MAXIMUM  X— DIHENS  ION  NXD  AND  PAR-DIMENSION  NPD 
C  THE  FOLLOWING  ARRAYS  ARE  USED  ONLY  WITHIN  COLSACB*  AND 
C  THEREFORE  ONLY  ACTUAL  DIMENSIONS  NX  AND  NP  ARE  NEEDED 

KRL«KRINV*NX*NX*NSET*I  $  KA*KRL*NX*I  t  KGG-KA*NX*NX* I 
KB-KGG*NX*NX*I  S  KO*K B+NP*NX* I 

KE«KD«-nP*NP*I  %  KBG»KE*NX*NP*I  $  KH-KBG*NP*NX* I 
KFF«KH*NP*NX*I  $  KAM*KFF*NP*I  $  K AN»KAM*NP*NP*I 
KRS*KAN*NP*NP*I  S  KTAU«KRS  +  NP*  I 

KEPS-KTAU*NP*I  S  KCOR*KEPS*NX* I  $  KGGFACT«KCOR*NP*NP*I 
KDUM-KGGFACT+NSET  %  K ANN*KDUM* NP* I  $  KTTAU»KANN*NP*NP* I 
KPLAST«KTTAU*NP*I  $  KCLAST*KPLAST*NP 
KANGAUS*KCLAST*NX*NSET  $  KRSGAUS-KANGAUS*NP*NP*I 
KANIN»KRSGAUS*NP*I 

KANL AST-KANIN*NP*NP*I  S  KRSLAST-K ANLAST • NP*NP* I 
KVD*KRSLAST*NP*I  $  KWMAT*KVD*NP*NP* I 
KEND*KWHAT*MAX0<NX*<3*NXi,NP*  <  3*NP> )*I-l 
IF(KEND.LE.NW)GOTO  25 
LBAO-NW 

PRINT  15»LBAD,KEN0,NW 
RETURN 

15  FORM  ATI 1HQ»10X»30HRETURN  FROM  COLSACA  WITH  LBAD*,I6, 

A34H  BECAUSE  STORAGE  REQUIREMENT  KEND*»I6> 

B24H  EXCEEDS  W-DIMENSION  NW-»I6> 

C 

25  PRINT  27*  KEND 

27  FORMAT ( 1H1* 10X*  34H ENTERING  THE  LEAST  SQUARES  ROUTINE* 

A  BH  COLSACA, /,1H  ,10X»25HTHE  PRESENT  RUN  REQUIRES  * 

B32HA  WORK  ARRAY  WITH  THE  DIMENSION  *I5,1H.*M 
IFCI.EQ.2)  GOTO  35 
C 

CALL  COLSACB(X»R»ALABEL,LSTX*NX,NSET,PAR,NP*FU, I  TYPE* 

A  XC*C»LSTN»NRGO»ERZ»V*ERP,LBAD,NXD,NPD* 


8  W(1)»W(KFP)»W(KFXX)»W(KFXP)»W(KFPP)»W(KRINVI» 

C  H(KRL),W< KA),W(KGG), W(KB), W{KD»,W(KE), W(KBG), 

0  W (KH )  , W(KFF),W(KAM), W(KAN) , W (KRS )»  W<KTAU», 

E  WIKEPS  If W(KCOR) , W(KGGFACT) , WIKOUM) , W(KANN) , W ( K T T AU I » W < KPL A S T )  , 
F  WCKCLASTJ, VCKANGAUS) ,W(KRSGAUSI,W(KANINI, 

G  W(KANLAST)»W(KRSLAST)»W(KVD)»W(KWNAT),MTRINVB) 

R  E  TU  R  N 
CONTINUE 

CALL  C0LSAC8(X»R»ALA8EL»LSTX»NX*NSET»PAR»NP»FU»ITYPE» 

A  XC,C»LSTN»NRGD»ERZ,V,ERP»LBAD,NXD»NPD» 

B  Will »WIKFPI,W(KFXX), W I  KF XP > , W C KF PP ) , W < KR IN V) , 

C  W(KRL)»W(KA)»W(KGG),W(KB),W(KD)»WlKE)»W(KBG)» 

0  W<KHI,W<KFFI,W(KAM»»  W< K  AN »  ,  W  (  KRS  ) »  W(  KT  AU )  » 

E  H(KEPS), W(KCOR), MIKGGFACTI, W < KDUM) , W (K ANN > , W (KTTAU ) , W < KPL AST) > 
F  W(KC L AST >, W< KANGAUSI ,W(KRSGAUS >,W< KANIN), 

G  W(KANLASTI»W(KRSLAST)»W(KVDI»W(KWNAT)»MTRINDBI 
RETURN 
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SUBROUTINE  COLS ACB(X, R>ALABEL,L$TX»NX,NR>PAR»NP»FU»IC, 

A  XC»C,LSTN»NRGD»ERZ»V»£RP»LBAD,NXD»NPD, 

B  FX»FP»FXX»FXP»FPP» 

C  RINV»RL»A»GG»8»D»E»BG»H»FF»AM»AN»RS»TAU» 

0  EPS,COR, GGF ACT, OUM, ANN, TTAU, PL AST, CL  AST, ANGAUS »RSGAUS» 

F  ANIN* ANLAST,RSLAST,VD,WMAT,NTRINDB) 

C  LEAST  SOUARES  ROUTINE  FOR  CORRELATED  DATA  AND  SCALAR  CONSTRAINTS 
DOUBLE  PRECISION  RL»G,  AK»  A,  DGG,  GG»  R  IN  V,  DB,  B  ,  DE  »  E  ,  D,  BG»H,  FF» 

A  RSGAUS»RS» AN, ANGAUS »HRH, AM, WP, TT AU,TAU, ANL AS T»  RSLAS T, WPLAST, 

B  ANN, ANIN, DUM, VD, WC»COR»W*DET, WL AST, BGE 
C 

C  X(NXD,NR) 

C  R(NXD,NXD,NR) 

C  AL  ABEL( 2 ,NR J 
C  LSTX(NR) 

C  NX 
C  NR 

C  PAR(NPO) 

C  NP 
C  FU 
C  IC 
C 
C 
C 
C 
C 

C  XC  (NXD,  NR  ) 

C  C  (  NX  D ,N R  ) 

C  LSTN(NR) 

C  V(NPD,NPDJ 
C  ERP(NPO) 

C  NXD 
C 

C  NPD 
C 

C  LB  AD 
C 

C  THE  REMAINING  ARGUMENTS  FX  THROUGH  WHAT  ARE  STORAGE  ALLOCATIONS 
C  SPECIFIED  BY  THE  SUBROUTINE  COLSACA.  A  FORMULA  FOR  THE 
C  REQUIRED  STORAGE  AREA  FOR  THESE  ALLOCATIONS  IS  GIVEN  IN  COLSACA 
C 

C  MTRINDB  •  NAME  OF  SUBROUTINE  FOR  MATRIX  INVERSION, 

C  ALSO  SPECIFIED  BY  THE  SUBROUTINE  COLSACA 

C 

DIMENSION  X(NXO,l),R(NXD,NXD,l),A  ABEL  (2,1)  »L  ST  X  ( 1 )  , 

AP  ARC  NPD ), XC (NXD, 1 ) , C( NXO, l ) , V( NPD, NPD ) , E  RP ( NPD ) , LSTN ( 1 ) , 

B  FX(NXO!,FP(NPDI , F XXC NXD, NX D I , FXP{ NXD, NPD ) , F PP ( NPD, NPD ) , 

C  RINV(NX,NX»1)»RL(NX),A(NX,NX),GG(NX,NX),B(NP,NXI,D(NP,NP), 

D  E(NX,NP),BG(NP,NXI,H(NP,NX),FF(NP) ,AM(NP»NP), AN ( NP , NP ) , R S ( NP > , 

E  TAU(NP),EPS(NX),C0R(NP»NP)»GGFACT<1)»0UM(NX)»ANN(NP,NP1* 

F  TTAU(NP),PLAST(NP),CLAST(NX, 1 ) , ANGAUS ( NP, NP) , RSGAUS(NP», 

G  ANIN(NP,NP),ANLAST(NP»NP),RSLAST(NP) ,VD(NP,NP) 

LEVEL  2,FX,FP,FXX,FXP,FPP,RINV,RL,A,GG,B,D,E,  BG, H,FF , AM, AN, RS» T AU, 
l  EPS,COR,GGFACT,DUM, ANN, TTAU, PL AST, CL  AST, ANGAUS, RSGAUS, ANIN, ANL AST 
2,RSLAST,V0,WMAT 

LEVEL  2,X,R, ALABEL, LS TX, XC , C , L STN 
NXMX-NXDS  NPMX-NPD 


■  NR  SETS  WITH  NX.LE.NXD  OBSERVATIONS  EACH 

•  VARIANCE-COVARIANCE  MATRICES  OF  OBSERVATIONS  X 
»  ALPHANUMERIC  LABELS  OF  OBSERVATION  SETS 

-  ONLY  SETS  WITH  ZERO  LSTX  WILL  BE  USED 

-  NUMBER  OF  OBSERVATIONS  IN  EACH  SET.  (NX.LE.NXD! 

-  NUMBER  OF  X-SETS,  INCLUDING  SETS  WITH  LSTX.NE.O 

•  PARAMETERS.  WILL  BE  REPLACED  BY  L.SQ.  SOLUTION 
»  NUMBER  OF  PARAMETERS.  ( 0. LE .NP . LE .NPD I 

«  NAME  OF  CONSTRAINT  SUBROUTINE 
-  ITERATION  TYPE  IN  BINARY  CODE 

■  0  -  NORMAL.  SET  C»0  AT  START,  BEGIN  WITH  PARAMETER 

ITERATION,  USE  NEWTON-RAPHSON  FORMULAS. 

■  1  -  DO  NOT  SET  C*0  AT  START 

«  2  -  START  ITERATION  WITH  RESIDUAL  UPDATING 

■  4  -  START  ITERATION  USING  GAUSS-NEWTON  FORMULAS 

■  CORRECTED  (ADJUSTED)  OBSERVATIONS  *  X*C 

-  RESIDUALS  (CORRECTIONS  OF  X) 

«  LSTN.NE.O  IF  THE  SET  WAS  NOT  USED  FOR  ADJUSTMENT 

-  VARIANCE-COVARIANCE  MATRIX  OF  THE  PARAMETERS 

-  STANDARD  ERRORS  OF  THE  PARAMETERS 

•  FIRST  DIMENSION  OF  X,  XC  AND  C,  AND  FIRST  TWO 
DIMENSIONS  OF  R  DECLARED  BY  DIMENSION  STATEMENT 

•  DIMENSIONS  OF  PAR,  V  AND  ERP  AS  DECLARED  BY 
DIMENSION  STATEMENTS 

-  LB AD. NE • 0  IF  ADJUSTMENT  CANNOT  BE  DONE  PROPERLY 


167 


C  MAXIMUM  DIMENSIONS  AS  DECLARED  BY  THE  CALLING  PROGRAM 
DATA!SU8NAM-9H  COLSACB  ) 

C  NAME  OF  THE  SUBROUTINE  FOR  ERROR  MESSAGES  AND  OUTPUT 
OATA( ITMAX-25), ( ERMAX-2. J 
C  IT  MAX  IS  THE  MAXIMUM  NUMBER  OF  ITERATIONS 
C  ERMAX  IS  FACTOR  IN  LOOP  1056  TO  CHECK  FOR  LARGE  RESIOUALS 
PRINT  11*SUBNAM 

11  FORMAT !  1H0* 10X*  3 7H ENTERING  THE  LEAST  SQUARES  SUBROUTINE* 

A  A 9*  A2HFQR  CORRELATED  DATA  ANO  SCALAR  CONSTRAINTS*/ 

A  1H  *10X*19HR0UTINE  USES  DOUBLE* 

B4  3H  PRECISION  ARITHMETIC  FOR  MOST  CALCULATIONS*//! 
IF(NX.GE.l.AND.NX.LE.NXMX)  GOTO  A5 
L  B  AD  ■  1  $  PRINT  15* SUBNAM 

15  FORM ATC 15H0  RETURN  FR0M»A9»  30H15  BECAUSE  NX  IS  OUTSIDE  RANGE  I 
25  FORMAT 1 3X*  3HNX-* 18*  3 OH  IS  THE  NUMBER  OF  OBSERVATIONS 

1  9H  IN  A  SET*/*3X* 3HNR** IB*  22H  IS  THE  NUMBER  OF  SETS*/* 

2  3X»  3HNP-* I8*20H  IS  THE  NUMBER  OF  PARAMETERS) 

30  PRINT  25*  NX*NR»NP 

PRINT  35*  LB  AO 
RETURN 

35  FORMAT! 3X*5HLBA0«* 16) 

A 5  IF (NR .GE.l ) GOTO  65 

LB AD*  2  $  PRINT  55*SUBNAM  %  GOTO  30 
55  FORMAT! 15H0  RETURN  F ROM* A9* 30H45  BECAUSE  NR  IS  OUTSIOE  RANGE) 
65  IF!NP.GE.O.ANO.NP.LE.NPMX.AND.NP.LE.NR)  GOTO  85 
L BAD* 3  t  PRINT  75*SUBNAM  $  GOTO  30 
75  FORMAT! 15H0  RETURN  FROM* A9* 30H65  BECAUSE  NP  IS  OUTSIDE  RANGE) 
85  LBAO-O  %  NRGD-0 

IF!IC.LT.0.0R.IC.GT.7)IC*0 
C  IC  IS  MEANINGFULL  ONLY  BETWEEN  ZERO  ANO  7 

GAUS-O.  %  IFIIC.GE.A) GAUS*1 •  t  MOOI-O 
C  GAUS-1.  INDICATES  THAT  GAUSSIAN  ITERATION  WILL  BE  USED 
C 

DO  135  KA*1*NR 
LSTN ! KA)*1 

IF!LSTX(KA)«NE«0)G0T0  135 
DO  95  KB*1*NX  $  DO  95  KC-1*NX 
95  A!KB*KC)-R!KB*KC*KA) 

C 

CALL  MTRI NDB! A*NX*  DUM*NX*0* DET* WMAT ) 

C  INVERT  MATRIX 
C 

IFOET.GT.O.)  GOTO  105 

C  ONLY  DATA  WITH  POSITIVE  OEFINITE  R  WILL  BE  ACCEPTED 
PRINT  100*KA*ALABELtl*KA|*ALABEL(2*KA) 

GOTO  135 

100  FORMAT  1 3X» A7HVAR IANCE  MATRIX  R  NOT  POSITIVE  DEFINITE  FOR  SET* 

A  1 5*  2 1H  WITH  LABELS  ALABEL-  *2A10) 

105  DO  115  KB- 1»NX  $  00  115  KC*1*NX 
115  RINV!KB*KC*KAI*A!KB*KC) 

C  RINV  IS  THE  INVERSE  TO  R  ANO  IS  NEEOED  TO  COMPUTE  W 
LSTN! KA )»0  *  NRG0-NRG0*1 
00  125  KB*1»NX 

IF!! IC/2) ♦2.EQ. IC )  C!KB*KA)*0. 

125  XC!KB*KA)«X(KB*KA)*C(KB*KA) 

135  CONTINUE 


115 


120 


125 


130 


135 


140 


145 


150 


155 


160 


165 


170 


1 F<NRGD<LE<  0 )  GOTO  145 
I F  (NP-NRGD  )  18  5,165,145 
145  LB  AO “145 

PRINT  150#  SUBNAM  $  PRINT  155#NRGD  t  GOTO  30 
150  FORMAT ( 15H0  RETURN  FROM# A9, 2 2H145  BECAUSE  NP.GT.NRGD) 

155  FORM  AT  I 3X»  5HNRGD“» 16, 27H  IS  THE  NUMBER  OF  GOOD  SETS) 

165  PRINT  175  >  SU8NAM  $  PRINT  155,NRGD  *  PRINT  25»NX,NR,NP 
175  FORMAT ( 14H0  WARNING  AT,A9,19H1?5  BECAUSE  NP«NRGD> 

185  I TERNR“0  *  IWTEST-0 

C  COUNTER  OF  ITERATIONS  ANO  CONVERGENCE  INDICATOR  FOR  W 
KPCT “0  «  IPTEST-O 

C  COUNTER  OF  PARAMETER  SUBITERATIONS  AND  CONVERGENCE  INDICATOR 
KCCT-0  $  ICTEST*0 

C  COUNTER  OF  RESIDUAL  SUBITERATIONS  AND  CONVERGENCE  INDICATOR 
E RZ* 1 •  $  W-  FLOATINRGD-NP)  i  WP“W 
PRINT  190, SUBNAM, IC 

190  FORMAT! 1H  , 10X, 20HITE RATION  RESULTS  BY, A9, 10X,16H( ITERATION  TYPE  , 
A3HIC«»  13, 1H »,///, 1H  , 2X,9HITERATI0N,8X, 1HW, 35 X, 10HP ARAMETERS, / /  I 
C 

C  ITERATION  STARTS  AT  195 

195  WL AS  T “W  $  WPLAST-WP  S  KPCT*0 
IF(NP.GT.O) GOTO  196 
PRINT  198, ITERNR,WS  GOTO  569 
196  DO  197  KA«1,NP 

197  PLAST(KA)“PAR(KA) 

KP«MIN0(NP»  51  S  PRINT  198, ITE RNR, W# (P AR (J ) , J-l, KP ) 

IFIKP.EQ.NPIGQTO  200 

KPP-KP+l  $  PRINT  199# (PAR(J),J“KPP,NP) 

198  FORMAT I4X#I5,1PE19.12#5X, 5!2X,1PE16.9>) 

199  FORMAT! 33X,5I2X,1PE16.9)) 

200  IF1ITERNR.GT.0)  GOTO  204 

IFIIC-4.GE.2I  GOTO  575  J  IF ! IC . EQ . 2 .OR. IC .EQ . 3 )  GOTO  575 
C  START  WITH  RESIOUAL  ITERATION  AT  575  IF  IC-2 

204  M ARQ“ 0 

C  MARO  INDICATES  NUMBER  OF  MARQUARDT  CORRECTIONS.  SEE  435. 

205  NRGDP-0  $  WP“0 

208  DO  217  KA“1,NPS  RS!KA)“O.J  RSG AUS ! KA > -0 . 

DO  217  KB “ 1, NP 

AM(KA#KB) “OS  AN  1 K A, KB ) “0. $  ANG AUS IK  A, KB ) “0. 

217  CONTINUE 
C 

225  00  405  KA«1»NR 

C  THIS  LOOP  ESTABLISHES  EQUATIONS  FOR  PARAMETER  CORRECTIONS 
IFILSTNIKA) .EQ.1IG0T0  405 
C 

CALL  FUIXC»KA,PAR,F,FX,FP,FXX,FXP,FPP,NBAD> 

C  THIS  IS  THE  CONSTRAINT  SUBROUTINE.  ITS  ARGUMENTS  ARE 

C  XCINXD, NR)  *  OBSERVATIONS 

C  KA  *  NUMBER  OF  SET  WHICH  WILL  BE  USED  FOR  CALCULATIONS 

C  PARINPD)  •  PARAMETER  VECTOR 

C 

C  THE  FOLLOWING  WILL  BE  CALCULATED  BY  FU 
C  F  »  CONSTRAINT  FUNCTIONAL 

C  FXINXO)  AND  FPINXP)  «  FIRST  ORDER  DERIVATIVES  OF  F 

C  FXXI NXD, NXO) ,  FXP! N XD, NPD ) #  FPP!NPD,NPD)  “  SECOND  ORDER  DERIVATIVES 
C  NB AO  “  NBAO.NE.O  IF  F  CANNOT  BE  COMPUTED  FOR  GIVEN  XC  AND  PAR 

C 


1 6  9 


175 


180 


185 


190 


195 


200 


205 


210 


215 


220 


235  IF(NBAD.EO.O)GOTO  245 

LSTN(KA>*  235000+1  AS S( NBAD )  %  GOTO  405 
245  00  255  KB«1,NX 

RL (KB  I *0  $  00  255  KC«1, NX 
255  RL(K8)*RL(KB)*R(KB,KC,KA)*FX(KC) 

G»0  $  DO  265  KB»1,NX 
265  G«G»FX(K8)*RL(KB) 

275  IF(G.GT.l.E-lOO) GOTO  285 
LSTN ( KA )«275 

PRINT  277,KPCT  $  PRINT  278, K  A,  ALABEK  1,  KA) ,  AL  ABEL  (  2,  KAI 
GOTO  405 

277  FORNATC  3X, 2 9H WEIGHT  G  NOT  POSITIVE  AT  275. ,9H  KPCT*,I4> 

278  F0RNAT(5X,3HKA»,I5,3X,7HALABEL»,2A10> 

285  G-l./G 

AK— F 

00  305  KB«1,NX  $  00  295  KC-1»NX 

A(KB»KC)-FX(KB)*RL(KC)*G 

IF(KB.EQ.KC)A(KB,KC)*A(KB,KC)-1. 

295  CONTINUE 

305  AK«AK>FX(KBI*C(KB,KAI 
AK«AK*G 
GGFACT(KA) *1. 

311  00  325  KB-1,NX  $  00  325  KC-1,NX 
DGG»0 

DO  315  KD-1,NX  $  00  315  K£«1»NX 
315  DGG*DGG+GGF ACT( K A I  *AK+R(K8»KD,  KA)*A(K0»KEI4FXX(KE»KC) 

IF(KB.EQ. KC )  DGG*DGG+1 . 

325  GG(KB ,KC) *0GG 

CALL  NTRIN0B(GG,NX,0UN,NX,0,0ET»WNAT) 

IF(DET.GT .1 .E-100) GOTO  335 

GGFAC T (KA) *GGFACT(KA) *0.5  %  IF (GGFACT (K A) .LT. 1. E-31 GGF ACT( KAI-O. 
C  FXX  IN  FORNULA  FOR  GG  IS  REOUCEO  FOR  NUNERICAL  STABILITY 
GOTO  311 

335  DO  345  KB-1,NX 

DB-0  S  00  337  KC-1,NX 
337  0B«DB*RL(KC»*FXX(KC,KBI 
DO  345  KC»1,NP 

B (KC , KB )■ AK*( FXP (KB»KC  I— G*FP(KC )*0B ) 

DE-0  $  00  339  KD-1»NX  %  DO  339  KE»1,NX 
339  OE-DE*R(KB,KO,KAI*A(KO,KEI*FXP(KE,KC» 

E ( KB, KC  )“G*RL(KB )*FP( KC )♦ AKPDE 
345  CONTINUE  ’ 

00  355  KB»1,NP 
0B»0  $  00  347  K0«1,NX 
347  OB»DB*RL( KO**FXP(KO,KB) 

00  355  KC»1,NP 

355  0(KC,KBI»G*FP(KBI*FP(KCI-AK*(FPP(KB,KCI-G*FP(KCI *0B ) 

DO  365  KB*1,NP  S  00  365  KC-1,NX 
BG(KB,KC)-0  S  00  357  KD-1,NX 
357  BG(K B,KC) »BG( KB,KC »*B ( KB, KD »*GG (KD, KC » 

365  CONTINUE 

00  385  KB"1»NP 
00  375  KC ■ 1 , N X 
OE-O  %  DO  367  K0-1,NX 
367  DE«DE»BG(KB,KD)*A(KC,KD> 

375  H(KB,KC)«G*FP(KBI*FX(KCMDE 
0E«0.*  00  377  KD«1» NX 
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377  0£«DE+BG(KB»KD>*( AK*RL !KD »-C i KD,K A) » 

384  F  F  ! K  B  )  ■  AK  *F  P !  KB  I  +D  E 

385  CONTINUE 

C  THIS  COMPLETES  CALCULATIONS  FOR  SET  KA.  NOW  ADD  UP  MATRICES 
DO  395  KB  =  1 »NP 

RS6AUS!K8)*RSGAUS1K8) ♦AKPFPIKB > 

RS!KB)«RS!K8»+FF!KB) 

C  THESE  ARE  RIGHT  HAND  SIDES  FOR  TAU  EQS. 

DO  395  KC 1 1 »  N  P 
BGE»0. %  DO  389  KD«1,NX 

389  BGE-BGE*BG(KB»KD)*E(KD>KC> 

390  AN!KB»K0*AN!K8»KC)'AD!KB»KC)«-BGE 
C  THIS  IS  MATRIX  OF  EOS.  FOR  TAU 

ANGAUS!KB,KC»«ANGAUS!KB,KCI*G*FP!KB)*FP!KC> 

HRH-0  S  DO  391  K0-1»NX  S  DO  391  KE«1»NX 

391  HRH*HRH*H!K8,K0I*R!K0»KE»KAI*H!KC»KEJ 
AM!KB»KCIaAM(KB»KCI*HRH 

C  THIS  IS  THE  INFLUENCE  MATRIX  OF  SET  KA 
395  CONTINUE 

WP*WP*AK**2/G 

NRG0P«NRGDP*1 

C  COUNT  GOOD  SETS  IN  COMPUTATION  LOOP  FOR  PARAMETERS 
405  CONTINUE 

C  ENO  OF  LOOP  225-405  OVER  ALL  SETS  OF  OBSERVATIONS 
C 

415  IFINP.LE.NRGDP. ANO.NRGDP.GT.OI  GOTO  425 
L  BAD ■ 41 5  S  PRINT  417,SUBNAM 

PRINT  419,NRGDP  *  PRINT  25»NX»NR,NP  %  PRINT  35*  LBAD  %  GOTO  1057 
417  FORM  AT ( 15H0  RETURN  FROM, A9, 23H415  BECAUSE  NP.GT.NRGDPI 

419  FORMAT! 3X,6HNRG0Pa, 15, 26H  IS  THE  NUMBER  OF  SETS  FOR, 

A52H  WHICH  CALCULATIONS  CAN  BE  PERFORMED  IN  LOOP  225-4051 
425  IFIKPCT.EQ.OIGQTQ  485 

C  AFTER  FIRST  PARAMETER  ITERATION  CHECK  IF  WP  DECREASES 
IFIWP.LT. WPLAST*1.10IG0T0  475 
I F (M ARQ.GT .10)  GOTO  475 

C  APPLY  NARQUARDT  IF  WP  HAS  INCREASED  TOO  MUCH 
435  MARQ«MAR0*1  $  AL AM-l 0. ** ! N ARQ-4 > 

DO  445  KA-1,NP  t  TT AU ( K A ) - RSL AS T ( K A ) 

DO  445  KB«1,NP  $  AN! KA ,KB > - ANL AS T! KA, KB ) 
IF!KA.EQ.KB)AN!KA,KB)>AN!KA,KBI*!ALAM*1.) 

445  CONTINUE 
C 

CALL  MTRINOB! AN, NP, TT AU,NP, 1, OET, WN AT ) 

C  INVERT  MATRIX  AND  SOLVE  LINEAR  EQUATIONS 
C 

IFtDET.NE.O. ) GOTO  455 
GOTO  435 

455  DO  465  KA«1»NP 

PAR!KA)»P AR!KA)-TAU!KA)*TTAU!KA> 

465  TAUUAI-TTAU1KAI 
GOTO  205 

C  NOW  REPEAT  AT  205  LAST  ITERATION  WITH  DIFFERENT  PAR 
C 

475  IF(MARQ.EQ.O) GOTO  485 
PRINT  477,MAR0,KPCT,WP 

477  FORMAT! 2X , 29HMARQUARDT  CORRECTION  APPLIED  ,14, 

A15H  TIMES  AT  KPCT-, 14, 5X, 3HWP*,1PE19.12 J 


485  WPLAS  T-WP  $  INOTAU-0 

IF(GAUS.NE.O. )GOTO  491 

487  00  489  KA-1,NPS  T AU ( K A ) *RS ( K A ) *  RSL AST (KA)-RS ( KA) 

00  489  K8-1»NP  %  ANLAST (KA,KB)«AN!KA,KB) 

489  ANN! K A, KB >» AN  IK A, KB) 

GOTO  495 

491  00  493  KA*1»NP$  TAU(K AI-RSGAUS IKAIS  RSL AST  I KA I -RSGAUS IK A ) 

00  493  KB- 1»  NP  $  ANLAST (KA ,KB ) - ANGAUS IKA, KB  I 
493  ANN(  K  A»  KB  )  >  ANGAUS  ! K A, KB ) 

495  CALL  MTRINOBI ANN, NP, TAU,NP, 1, DET, WHAT ) 

IFIDET.NE.O.JGOTO  511 
IFIINDTAU.EQ.0)G0T0  509 
LBAO-495  %  PRINT  497, SUBN AN, LBAD 
497  FORMAT ( 15H0  RETURN  FROM, A9, 1 4H495  WITH  LBAD-,14, 

A52H  BECAUSE  MATRIX  ANN  OF  EQUATIONS  FOR  TAU  IS  SINGULAR) 
PRINT  498 

498  FORMAT)  31  HO  THE  SINGULAR  GAUSS  MATRIX  IS»/> 

00  499  KA-1»NP 

PRINT  500, IANGAUSIKA, J),J«1,NP) 

499  CONTINUE 

500  FORMAT ( 1H  , 10(1X, 1PE12.5I ) 

PRINT  501 

501  FORMAT! 32H0  THE  SINGULAR  NEWTON  MATRIX  IS,/) 

00  502  KA-1»NP 

PRINT  500,IANIKA,J),J-1,NP) 

502  CONTINUE 
RETURN 

509  INOTAU-1*  IFIGAUS.NE. 0. )GOTO  487 
GOTO  491 

511  INDVAR-0 

IFIINOTAU.EQ.O. ANO<GAUS<EQ<  0« ) GOTO  515 
IF1INDT AU.NE.O. ANO.GAUS.NE.O. )GOTO  515 
C  BRANCH  TO  515  IF  ANN  CONTAINS  THE  INVERSE  OF  NEWTON  MATRIX  AN 
IFIGAUS.EQ.O..ANO.INOTAU.NE.O)  GOTO  514 
C  BRANCH  TO  514  IF  NEWTON  MATRIX  AN  WAS  SINGULAR 
00  512  KA-1,NP  S  00  512  KB-1,NP 

512  ANINIKA,KB)-AN|KA,KB) 

CALL  MTRINDB!ANIN»NP» OUM, NP,0,0ET,WMAT) 

IFIDET.EO.O. )  GOTO  514 

00  513  KA-1,NP  S  00  513  KB-1,NP 

513  ANNIKA,KB)-ANIN!KA,KB ) 

GOTO  515 

514  INDVAR-1 

C  INOVAR-1  INDICATES  THAT  GAUSS  MATRIX  USEO  FOR  VARIANCES 
515  00  525  KA- 1»NP 

PAR(KA)-PAR(KA),TAU(KA) 

DO  525  KB-1,NP 

VD(K A,KB)«OS  00  517  KC-l.NP  »  00  517  KD-1,NP 
517  VDIKA,KB>»VDIKA,KB)*ANNIKA,KC)*AMIKC,KD)*ANN!KB»KD) 

525  CONTINUE 

KPCT-KPCm 
IFIMARO.NE.OIGOTO  555 

C  APPLY  CONVERGENCE  TESTS  ONLY  IF  MARQUART  WAS  NOT  USEO 
C 

DE-O.  %  DO  535  KA-1,NP  $  00  535  KB-1,NP 
535  DE-OE*TAUIKA)*AN!KA,KB)*TAU!KB) 

FTEST-10. ♦•(-MIN0(10, ITERNR^2) )*( l.*99.*GAUS> 


S DE-  DE  $  IF<ABS<SOE )  .GT.WP*FTEST )  GOTO  555 
FTEST»AMAX1CERZ#0.01)*10.**(-MIN0(8,ITERNR*2)  )*<  l.+99.*GAUS) 
IPITER-0 
00  545  KA-1»NP 

STAU-TAUIKA)  $  SVD-  VO(K A> KA ) 

IF(ABS(STAU).LT.SQRT( SVD)*FTEST>  IPITER-IPITER+1 
545  CONTINUE 

IF(IPITER.EQ.NP)GOTO  565 
555  IF(KPCT.LE.11)G0T0  204 
565  PRINT  5  67  »  K  PC  T 

567  FORMAT ( 1H  , 10X» 5HKPCT -, I4» 24H  «  PARAMETER  ITERATIONS) 

PTES  T- AMAX1 (ERZ»  0.01>*1.E-8*{1 •♦99. *GAUS ) 

00  568  KA-1#NP 
S  VD-VOC  KA»KA) 

IF(ABS(PAR( KA)— PL ASTI KA)).GT.SQRT(SVO)*PTEST)  IPTEST-0 
568  CONTINUE 
569  IPTEST-IPTESTn 

C  IPTEST  COUNTS  CONSECUTIVE  PASSES  OF  TESTS  FOR  PAR 
C  ENTER  569  FROM  195  IN  PROBLEMS  WITHOUT  PARAMETERS 
C 

570  IF«IPTEST.GT.2.AND.IWTEST.GT.2.AND.ICTEST.6T.2>G0T0  785 
C  THIS  IS  TEST  ANO  BRANCH  FOR  REGULAR  RETURN 
575  IF(ITERNR.GT.ITMAX»MQOI)GOTO  775 
KCCT-0  %  IEPTE-1 

C  COUNTER  OF  RESIOUAL  ITERATIONS  AND  RESIDUAL  CONVERGENCE  INDICATOR 
00  577  KA-1»NR  S  DO  577  KB-1#NX 

577  CLASTIKBf  KA)-C(KB.KA) 

EPTEST-AMAX1<ERZ»0.01)*10.*P(-MIN0{8»ITERNR*2) )  * ( 1. *99 . *GAUS) 

C 

C  RESIOUAL  ITERATION  STARTS  AT  578 

578  W-0  *  NRGDC -0 
DO  745  KA-1*NR 
IF(LSTN(KA)»EQ.1)G0T0  745 
LSTN<  KA)-0 

CALL  FUCXC,KA,PAR,F»FX»FP»FXX,FXP»FPP»NBAD) 

585  IFINBAO.EQ.OIGOTO  595 

LSTN<KA)-585000«-IABS(N8AD>  %  GOTO  745 
595  00  605  KB-1#NX 

RL(KB ) *0  $  00  605  KC-1*NX 
605  RL(KB)«RL(KB)4R(KB»KC#KA)*FXCKC) 

6-0  %  DO  615  KB- 1»NX 
615  G-G»FX(KB)*RL(KB) 

625  IF(G.GT.1.E-100)G0T0  635 
LSTN(KA)-625 

PRINT  627»  KCCT  $  PRINT  278, K A, ALABEU l,KA ) , AL ABEL ( 2, K A ) 

GOTO  745 

627  FORM  ATI 3X.29HWEIGHT  G  NOT  POSITIVE  AT  625. ,9H  KPCT-,14) 

635  G-l./G 
AK— F 

00  655  KB-1,NX  $  DO  645  KC-1,NX 
A(K8»KC)«FX(K8)*RL(KC)*G 
IFCKB.EQ.KC)A(KB,KCI- A(KB.KC )-l. 

645  CONTINUE 

655  AK-AK*FX(KB)*C(KB,KA) 

AK«AK*G 
GGFACT (KA) -1. 

665  00  685  KB-1,NX  S  00  685  KC-1,NX 
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3 

i 
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u 
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i 

I 
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430 


435 


440 


445 


450 


455 


.  *  IF (G AUS • NE • 0. )  GOTO  681 

00  675  KO-l.NX  S  DO  675  KE-l.NX 
675  DGG-DGG+GGF ACT( K A) ♦AK*R(KB»KD»KA)*A(KD»KE)*FXX(KE.KC) 

681  IFCKB.EQ.KC)DGG«DGG*1. 

685  GG(KB»KC)«DGG 

CALL  MTRINDBIGG.NX.DUM.NX.O.DET.WMAT) 

IF(0ET.GT .l.E-100)G0T0  695 

GGFACTCKA ) -GGFACT (K A) *0. 5  $  IF (GGFACT (K A) .LT. 1 . E-3 I GGFACT! K A) -0. 

C  REOUCE  INFLUENCE  OF  FXX  IN  GG  TO  IMPROVE  STABILITY 
GOTO  665 

695  00  715  KB  - 1 .  N  X 
EPS<KB>-0 
00  715  KC  - 1 »  N  X 

715  EPS<KB)-EPS(KB)+GG(KB.KC)*! AK*RL(KC)-CCKC.KA) ) 

00  725  KB-l.NX 

I F (  ABS(EPS(KB) ) .GT.EPTEST*  S QRT t R C KB. KB, K A ) )) I EPTE -0 
C(KB*KAI-C(KB»KA)+EPS(KB) 

725  XC<KB»KA)-X(KB»KA)*C(KB»KA) 

WC-0  $  DO  735  KB-l.NX  t  DO  735  KC-l.NX 
735  WC-C(KB.KA) *RINV< KB.KC »KA )*C C KC.KA) *WC 
W-W+WC 

NRGOC-NRGOC+1 

745  CONTINUE 

C  END  OF  LOOP  575-745  FOR  UPOATING  OF  RESIDUALS 
C 

IF(NP.GT.NRGOC.OR.NRGOC.LE.O)  GOTO  765 
KCCT-KCCT+1 

IF(KCCT.GT.11)G0T0  746 
IEPTE-IEPTE41  %  IF(IEPTE.LE.l) GOTO  578 

746  PRINT  747»KCCT 

747  FORMAT ( 1H  ,10X.5HKCCT«#I4»23H  -  RESIDUAL  ITERATIONS) 

SW-W  *  WTEST-AMAX1(SW,FL0AT(NRGD-NP)*0.01)*1.0E-10M1.*99.*GAUS) 

C  THIS  TAKES  CARE  OF  EXACT  OATA  FOR  WHICH  W-0. 

SWWL -W— WL AST  t  IF  C  ABS( SWWL ) .GT.WTEST )  IWTEST-0 
EPF  -AMAXl(ERZ.O.Ol) *1.E— 8*1 1 •♦99. *GAUS ) 

DO  755  KA-1,NR  $  IF ( L STN( K A ) .NE .0 ) GOTO  755 
DO  754  KB -1» NX 

IFC  ABSIC (KB.KA)-CLAST(KB.KA)) .GT.EPF*  SORT (R(KB.KB.KA) ) IICTEST-0 
754  CONTINUE 
755  CONTINUE 

iWTEST-IWTESm  *  ICTEST-ICTESm 

ITERNR«ITERNR>1 

ERZSO-1. 

IF(NP.GT.NRGDC)ERZSQ-W/  FLOAT ( NRGDC-NP ) 

ERZ-SQRT(ERZSQ) 

GOTO  195 

C  BRANCH  TO  195  FOR  NEXT  ITERATION 
C 

765  LB AO -74 5  %  PRINT  767.  SUBN AM  l  PRINT  747.KCCT  $  PRINT  768.NRG0C 
PRINT  25. NX.NR.NP  %  PRINT  35.LBAD  $  GOTO  1057 

767  FORMAT ( 15H0  RETURN  FROM. A9 . 2 3H745  BECAUSE  NP.GT.NRGDC) 

768  FORMAT ( 3X  »  6HNRGDC-. 15. 26H  IS  THE  NUMBER  OF  SETS  FOR. 

A52H  WHICH  CALCULATIONS  CAN  BE  PERFORMED  IN  LOOP  575-745) 

775  L  BAD- IT MAX 

C  ENTER  775  FROM  575  IF  TOO  MANY  ITERATIONS 

776  PRINT  777. SUBNAM 

777  FORMAT! 1H1. 10 X. 34HRESULTS  OF  ADJUSTMENT  BY  THE  LEAST. 
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A19H  SQUARES  SUBROUT INE , A9, / / > 

PRINT  779, ITMAX,LBAD 

779  FORMAT ( 43H0  WARNING.  THIS  IS  NOT  A  REGULAR  RETURN# /, AH  , 

460  A39(IH-I,/,49H  COMPUTATION  INTERRUPTED  BECAUSE  THE  NUMBER  OF, 

B27H  ITERATIONS  EXCEEDED  ITMAX*»I5»  9H  LBAD-,15, 

C45H  TO  CONTINUE  ITERATION  RESTART  WITH  ODD  IC ,//) 

GOTO  795 

C  ENTER  785  FROM  570  FOR  A  REGULAR  RETURN 
465  785  IFlGAUS.EQ.O.)GOTO  788 

PRINT  786  %  MOD  1*3 

[PTEST*0  $  IWTEST*0  t  ICTEST*0  $  GAUS«0.  t  GOTO  195 

786  FQ RN ATI 1H0»5X»35H SWITCH  ITERATIONS  TO  NE WTON-RAPHSON, / I 

C  BRANCH  TO  195  FOR  ADDITIONAL  NEWTON  ITERATIONS  AFTER  GAUSS  ITERATIONS 
470  788  PRINT  777,SUBNAM 

795  IFINRGDC. EQ.NRGD) GOTO  815 
PRINT  805 

805  FORM AT ( 41H0  WARNING.  SOME  OBSERVATION  SETS  COULD, 

A30H  NOT  BE  USED  FOR  COMPUTATIONS.,//) 

475  815  IFINP.LT.  NRGDOGQTO  835 

PRINT  825 

825  FORMAT  1 41H0  WARNING.  THE  NUMBER  OF  PARAMETERS  IS, 

A47H  EQUAL  TO  THE  NUMBER  OF  USABLE  OBSERVATON  SETS.,//) 

835  PRINT  845,NP,NRG0,NRGDP,NX,  ITERNR 
480  845  FORMAT ( 10X, 20HNUMBER  OF  PARAMETERS, 10X, 15, /, 

A10X, 26HNUMBER  OF  OBSERVATION  SETS,4X, 15, /, 

BIOX,  19HNUMBER  OF  SETS  USE D, 11X , 15, / , 

C10X, 21HDIMENS ION  OF  EACH  SET,9X,I5,// 

DI  OX, 20HNUMBER  OF  ITER  AT  IONS , 10X, 1 5, // ) 

485  PRINT  855, W 

855  FORMAT! 10 X, 34HWEIGHTE  0  SUM  OF  CORRECTION  SQUARES»8X, 

A  7HW  *» 1PE16.9, //  ) 

IFINP.LT. NRGOOGOTO  885 
ERZ-O.  $  VARZ-O. 

490  PRINT  875 

875  FORMAH10X,40HVARIANCE  OF  WEIGHT  ONE  AND  CORRESPONDING,/# 

A10X, 41HST  ANDARD  ERROR  NOT  COMPUTABLE  BECAUSE  THE# 

BIOX, 47HNU  M8ER  OF  PARAMETERS  EQUALS  THE  NUMBER  OF  SETS.,//) 

GOTO  894 

495  885  VARZ«W/  FLOAT INRGOC-NP ) 

ERZ«0 

IFIVARZ.GT.O. )ERZ-  SQRTIVARZ  ) 

894  PRINT  895#  V  AR Z, ER  Z 

895  FORMAT  1 10X, 22HV AR I ANCE  OF  WEIGHT  ONE# 20X, 7HERZ**2»# 1PE16.9# / 

500  A10X,  39HST  ANDARD  ERROR  OF  A  SET  WITH  WEIGHT  0NE,3X,7HERZ  •# 

B1PE16.9,/ / ) 

IF  IN  P . EQ. 0 ) GOTO  1028 

C 

905  PRINT  915 

505  915  FORMAT  1 1H  , 13X, 10HP AR AMET ER S, 8X, 16HLAST  CORRECTIONS, 6X» 

A15HST ANDARD  ERRORS, 6X, 15HST ANDARD  ERRORS, /,1H  ,77X» 

B9HTIMES  ER Z, / /) 

DO  910  KA* 1 »  NP 

S  VO*  VOI KA  »  K A )  J  ERPIKA)*SQRTISVD) 

510  ERPZ-ERPI  KAMERZ  J  01 FP-PLA STI KAJ-P AR IK  A ) 

PRINT  925,PAR(KA),0IFP,£RP!KA),ERPZ 

910  CONTINUE 

925  FORMAT! 1H  , 5X,4 I 5X, IP E16. 9) > 
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IF1INDVAR  .NE.O)  PRINT  928 

515  928  FORMAT ( 42H0  WARNING.  SECOND  ORDER  DERIVATIVES  WERE. 

A43H  NOT  USED  FOR  VARIANCE  CALCULATIONS  BECAUSE./. 

81H  » 12X.29HTHE  NEWTON  MATRIX  IS  SINGULAR) 

PRINT  935 

935  FORMAT! IH  .//, 1H  ,10X,24HTHE  FACTOR  ERZ**2  IS  NOT, 

520  A34H  INCLUDED  IN  THE  VARIANCE  MATRIX  V) 

965  00  975  KA«1,NPS  DO  975  KB-l.NP 

V(KA» KB)* VDCKA.KB )  S  SVD*VD!KA»KA)*VD!KB»KB) 

975  COR<  KA,KB)*V(KA,KB)/  SQRT(SVD) 

995  PRINT  1005 

525  1005  FORM  AT ( 1H  , // /» 10X, 25HC0RREL AT  ION  MATRIX  OF  THE. 

A11H  PARAMETERS,//) 

00  1015  KA-l.NP 

PRINT  1025,!C0R!KA,J),J*1,NP) 

1015  CONTINUE 

530  1025  F  ORM AT (1X,10(2X,F11.9) ) 

C 

1028  K  PR*0 

00  1045  KA*1,NR 
IF(LSTN(KA).NE.O)GOTO  1045 
535  I F(GGF ACT !KA)*EQ.1.)G0TQ  1045 

IF(KPR.E0.0)PRINT  1035 

1035  FORMAT ( 1H  , //,3X» 33HF OR  THE  FOLLOWING  SETS  THE  SECOND, 

A55H  DERIVATIVES  FXX  HAVE  BEEN  REDUCED  BT  THE  SHOWN  FACTORS, 
B//.5X.10HSET  NUMBER, 5 X, 6HF ACT0R.9X, 10HSET  LABELS,/) 

540  KPR*1 

PRINT  1037, KA.GGF ACT!  KA) , AL ABEL ! 1,KA),ALABEL(2,KA) 

1037  F0RMAT(8X,I4,6X,1PE12.5,5X,2A10) 

1045  CONTINUE 

IFIERZ.EQ.O.)  GOTO  1057 

545  C 

$Q«ERMAX*ERZ  *  DUMSS* SQ**2 
KPR* 0  *  DO  1056  KA*1, NR 
IF!LSTNIKA).NE.O)  GOTO  1056 
OUMS-O.  S  00  1050  KB* 1,NX  %  00  1050  KC-l.NX 
550  1050  DUMS*OUMS ♦C(KB,KA)*RINV(KB,KC,KA)*C(KC,KA) 

IF(OUMS.LT . OUMSS )  GOTO  1056 
IF1KPR.EQ.0)PRINT  1052,ERMAX,SQ  *  KPR*1 
1052  FORMAT! 1H  ,//,lH  ,3X,35HTHE  FOLLOWING  SETS  HAVE  CORRECTIONS, 
A24H  LARGER  THAN  ERMAX*ERZ  *,F4.1,8H  *  ERZ  -,1PE12.5, //, 1H  ,4X, 
555  B7HSET  NR. , 10X.6HL ABELS, 11X, 14HSQRT! C*RINV*C ),/ ) 

OUMS “SORT ( OUMS ) 

PRINT  105 4, K A, AL ABEL! 1,KA I , AL ABEL! 2,KA) , OUMS 
1054  FORMAT ! 1H  , 5X, 14, 5X,2 A10,  5X,1PE12.5) 

1056  CONTINUE 

560  C 

1057  KPR-0  $  00  1065  KA-l.NR 

IF(LSTXIKA).NE.O)  GOTO  1065  *  IFILSTN!KA> .EQ.O)  GOTO  1065 
IFIKPR.EQ.O)  PRINT  1059  S  KPR*1 
1059  FORMAT! 1H  ,//,lH  , 32HTHE  FOLLOWING  SETS  HAVE  NOT  BEEN, 

565  A25H  USEO  IN  THE  CALCULATIONS, //» IH  »3X»7HSET  NR..11X, 

B6HLABELS, 12X, 4HLSTN, / ) 

PRINT  1062,KA,ALA8EL!1,KA),ALABEL!2,KAI,LSTN!KA) 

1062  FORM  AT ! IH  , 5X, 14, 5X, 2 A10,  3X.I7) 

1065  CONTINUE 

570  RETURN  176 

END 
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SUBROUTINE  HTRINDB I  A, NX, R S» N A, K I N. DET, W ) 

DOUBLE  PRECISION  A* RS * DET»D1» D2»W 
C  MATRIX  INVERSION  ROUTINE 
C  NX  ■  ACTUAL  DIMENSION  OF  A 

C  NA  -  OINENSIQN  OF  A(NA»NA )  AS  DECLAREO  BY  DIMENSION  STATEMENT 
C  W  HUS  T  HAVE  THE  LENGTH  NA*C3*NA)  OR  MORE 
C  KIN-0  -  COMPUTE  INVERSE.  KIN-1  -  SOLVE  ALSO  A*X«RS. 

C  AT  RETURN  A  IS  REPLACED  BY  ITS  INVERSE  AND  RS  IS  REPLACED  BY  THE 
C  SOLUTION  X  (THE  LATTER  IF  KIN-1) 

C  USES  SUBROUTINES  LUOATD  AND  LUELHD 
DIMENSION  A(NA»1)»RS(1)»W(NA»1) 

LEVEL  2»A»  RS»  W 
DET-0 

IF(NX.L£.O.OR.NX.GT.NA)GQTO  55 
IF(KIN.LT.O.OR.KIN.GT.l)  GOTO  55 
DO  15  KA«1»NX  $  DO  15  KB«1»NX 
15  W(KA,KB)-A(KA,KB) 

CALL  LUDATD(H»W> NX»NA»D1»D2> U( 1»NA*1)»W( If NA*2)»NBAD) 
IF(NBAD.NE.O)  RETURN 
DET»D1*2.**02 
00  35  KA- 1»  NX 
DO  25  KB«1»NX 
25  M (K8»  NA>3 ) -0 
W(KA>NA*3)-1. 

CALL  LUELHO(W*W( 1»NA*3)*W(1»NA*1)»NX»NA» A(1»KA) ) 

35  CONTINUE 

IF(KIN.EQ.1)CALL  LUELMDI W»RS  »  W(1»NA*1)»NX»NA»RS) 

RETURN 

55  PRINT  65»  NX#NA»KIN 
RETURN 

65  FORM  ATI 1H  » 10X#  26HERR0R  CALLING  MTRINDB.  NX-,IA, 

A7H*  NA-,IA,7H,  KIN-»I*> 

END 
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SUBROUTINE 

LUDATD 

(A,  UL,N,IA,D1,D2, IPVT, EQU IL, I ER ) 

DOUBLE  PREC 

IS  ION 

UL,D1, D2, EOUIL, P»Q, SUM, BIG, RN 

c 

U 

c 

FUNCTION 

- 

L-U  DECOMPOSITION  BY  THE  CROUT  ALGORITHM 

L» 

c 

USAGE 

- 

CALL  LUOATD(A,UL,N, I A, Dl, D2, IPVT, EOUIL, IER ) 

c 

PARAMETERS 

A 

- 

INPUT  MATRIX  OF  DIMENSION  N  BY  N  CONTAINING 

H 

c 

THE  MATRIX  TO  BE  DECOMPOSED 

LI 

c 

UL 

- 

REAL  OUTPUT  MATRIX  OF  DIMENSION  N  BY  N 

LI 

c 

CONTAINING  THE  L-U  DECOMPOSITION  OF  A 

LI 

c 

ROWWISE  PERMUTATION  OF  THE  INPUT  MATRIX. 

Li 

c 

N 

- 

INPUT  SCALAR  CONTAINING  THE  ORDER  OF  THE 

V 

c 

MATRIX  A. 

L 

c 

IA 

- 

INPUT  SCALAR  CONTAINING  THE  ROW  DIMENSION  OF 

Li 

c 

MATRICES  A  AND  LU  IN  THE  CALLING  PROGRAM. 

Li 

c 

01 

- 

OUTPUT  SCALAR  CONTAINING  ONE  OF  THE  TWO 

Li 

c 

COMPONENTS  OF  THE  DETERMINANT.  SEE 

Li 

c 

DESCRIPTION  OF  PARAMETER  D2,  BELOW. 

L 

c 

02 

- 

OUTPUT  SCALAR  CONTAINING  ONE  OF  THE 

L 

c 

TWO  COMPONENTS  OF  THE  DETERMINANT.  THE 

L 

c 

DETERMINANT  MAY  BE  EVALUATED  AS  (D1)(2**D2) 

L 

c 

IPVT 

- 

OUTPUT  VECTOR  OF  LENGTH  N  CONTAINING  THE 

L 

c 

PERMUTATION  INDICES.  SEE  OOCUMENT 

Li 

c 

(ALGORITHM). 

L> 

c 

EOUIL 

- 

OUTPUT  VECTOR  OF  LENGTH  N  CONTAINING 

L 

c 

RECIPROCALS  OF  THE  ABSOLUTE  VALUES  OF 

L 

c 

THE  LARGEST  (IN  ABSOLUTE  VALUE)  ELEMENT 

L 

c 

IN  EACH  ROW. 

L 

c 

IER 

- 

ERROR  PARAMETER 

L 

c 

-  0  MEANS  NO  ERROR 

c 

-  129  MEANS  THAT  MATRIX  A  IS 

c 

ALGORITHMICALLY  SINGULAR 

c 

PRECISION 

- 

DOUBLE 

c 

c- 

LANGUAGE 

_  . 

FORTRAN 

L 

-L 

C  LATEST  REVISION  -  AUGUST  15,  1973  L 

C  CHANGE  TO  OOUBLE  PRECISION  AT  BRL  -  12  APRIL  1979 

C  L 

DIMENSION  A(IA,1),UL(IA,1),IPVT(1),EQUIL(1) 

LEVEL  2,A,UL,IPVT,EQUIL 

C  INITIALIZATION  L 

IER  •  0  L 

RN  «  N  $  Dl*l. 0  S  02-0.0 
DO  10  I-1*N  $  BIG-0.0 

DO  5  J»1,N  L 

P  -  A  ( I,  J  )  L 

UL( I , J  )  -  P  L 

IF(P.LT.O.O)  P— P 

IF  IP  .GT.  BIG )  BIG  «  P  L 

5  CONTINUE  L 

IF  (BIG  .EO.  0.0  >  GO  TO  110 
EQUIL(I)  -  1.0/BIG 

10  CONTINUE  L 

DO  105  J-  1 »  N  L' 

JM1  «  J-l  L1 

IF  (JM1  .LT.  1>  GO  TO  40  L1 

C  COMPUTE  U(I,J),  1-1,..., J-l  L 

L 


DO  35  1*1, JM1 
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25 


SUM  -  UK  I>  J  ) 

IM1  *  1-1 

IF  (IM1  .LT.  1)  GO  TD  35 
00  30  K*l» IM1 

SUM  ■  SUM— UL (I»K)*UL(K»J) 

CONTINUE 
Ul( I »  J )  *  SUM 
CONTINUE 
P  -  0. 0 

COMPUTE  U(J,J)  AND  L<I,J)»  I*J*1, 

DO  70  I«J,N 

SUM  *  UL( I»  J  ) 

IF  ( JM1  .LT.  1)  GO  TO  65 
DO  60  K*1,JM1 

SUM  *  SUM-UL (I»K)*UL(K»J) 

CONTINUE 
UL(  I  »  J  )  *  SUM 

Q-EQUIL  (I  )  *SUM  $  IF(Q.LT.O.O)  Q—Q 
IF  (P  . GE .  Q)  GO  TO  70 
P  -  Q 
IMAX  -  I 
CONTINUE 

TEST  FOR  ALGORITHMIC  SINGULARITY 
IF  <RN*P  .EQ.  RN)  GO  TO  110 
IF  (J  .EQ.  IMAX)  GO  TO  80 

INTERCHANGE  ROWS  J  AND  IMAX 

0 1  *  -01 
00  75  K«1,N 

P  *  UL  (  IM  A  X  »  K  ) 

ULC I M  AX»K )  -  UL ( J>K  ) 

UL(  J  »K)  -  P 
CONTINUE 

EQUIL(IMAX)  *  EQUIK  J) 

IPVT(J)  *  IMAX 
01  «  0 1*UL ( J >  J ) 

IF(D1*D1.LE.1.0)  GOTO  90 

01  -  01/16.0  $  02»D2*4.0 

GO  TO  85 

IF(D1.GE. 0.0625  .OR.  Dl.LE.-O. 0625)  GOTO  95 
01  *  01*16.0  $  02*02-4.0 

GO  TO  90 
CONTINUE 
JP1  «  J*1 

IF  (JP1  .GT.  N)  GO  TO  105 

DIVIDE  BY  PIVOT  ELEMENT  U(J»J) 

P  *  UL(JfJ) 

00  100  I«JP1,N 

UL(I,J)  «  UL ( I »  J ) / P 
CONTINUE 
CONTINUE 
RETURN 

ALGORITHMIC  SINGULARITY 

IER  «  129 
01-0.0  »  02*0.0 
RETURN 
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SUBROUTINE  LUELMD  ( A, 8* IPVT* N, IA» X) 
DOUBLE  PRECISION  A,B,X,SUM 


“  , 

■  “ 


L'  .* 
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w 


k.' 
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30 


35 


AO 
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C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c- 

c 

c 

c 


c 


c 


FUNCTION 

USAGE 

PARAMETERS  A 


B 

IPVT 


N 

IA 

X 

PRECISION 

LANGUAGE 


L 

ELIMINATION  PART  OF  SOLUTION  OF  AX-B  -  L' 

FULL  STORAGE  NODE 
CALL  LUELHD  (A*B*IPVT»N*IA*X) 

THE  RESULT »  LU,  COMPUTED  IN  THE  SUBROUTINE  L 
*LUOATD*»  WHERE  l  IS  A  LOWER  TRIANGULAR 
MATRIX  WITH  ONES  ON  THE  MAIN  DIAGONAL.  U  IS  L1 


UPPER  TRIANGULAR*  L  AND  U  ARE  STORED  AS  A  L 
SINGLE  MATRIX  A*  AND  THE  UNIT  DIAGONAL  OF  L 
L  IS  NOT  STORED 

B  IS  A  VECTOR  OF  LENGTH  N  ON  THE  RIGHT  HAND  L 
SIDE  OF  THE  EQUATION  AX»8  L 

THE  PERMUTATION  MATRIX  RETURNED  FROM  THE  L 

SUBROUTINE  *LUOATD*»  STORED  AS  AN  N  LENGTH 
VECTOR  L 

ORDER  OF  A  ANO  NUMBER  OF  ROWS  IN  B  L 

NUMBER  OF  ROWS  IN  THE  DIMENSION  STATEMENT  L 

FOR  A  IN  THE  CALLING  PROGRAM.  L 

THE  RESULT  X  L 

DOUBLE 

FORTRAN  L 


-l 


LATEST  REVISION  -  APRIL  11*1975  t 

CHANGE  TO  DOUBLE  PRECISION  AT  BRL  -  12  APRIL  1979 

L 

DIMENSION  A(IA*l)*B(l)*IPVTm»X(l>  L 

LEVEL  2.A,B,IPVT,X 

SOLVE  IT  •  J  FOR  r  l 

DO  5  I«1,N  l 

5  X(I)  «  Bill 

IW  -  0  LI 

DO  20  I«1*N  U 

IP  -  IP VT(  II  Li 

SUM  -  X(IPI  Li 

X(IP)  -  XCIl  L' 

IF  (IW  .EQ.  0)  GO  TO  15  U 

I  Ml  «  I-I  Li 

00  10  J*IW»IM1  L' 

SUM  «  SUM— A( I* J  )*X(JI  Li 

10  CONTINUE  Li 

GO  TO  20  L1 

15  IF  (SUM  .NE.  0.1  IW  -  I  L> 

20  X(II  •  SUM  Li 

SOLVE  UX  ■  V  FOR  X  U 

DO  30  I8*l»  N  Li 

I  «  Nn-IB  Li 

IP1  -  1*1  Li 

SUM  «  X C I »  U 

IF  (IP1  .GT.  N)  GO  TO  30  LI 

DO  25  J-IP1»N  Ll 

SUM  -  SUM— A ( I  *  J I  *  X ( J I  Ll 

25  CONTINUE  Ll 

30  X  ( I >  -  SUM  /  A (  I*  1 )  Ll 

RETURN 
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APPENDIX  C 

BLAST  FIELD  HISTORY  COMPUTATION  PROGRAM  BLAFHI 


HISTORY 

READAM 

READS P 

READFP 

FLOFLD 

STRBEG 

STRLIN 

FLINTER 

PFIELD 

QFUNCT 

ACOEF  . 

BCOEF  . 

CCOEF  . 

COEFFI 

SHOCK  . 

SHOCK2 

SHTINT 

ROMBIN 

SHODER 

F2SHCK 

F2DER  . 

ROMULT 


APPENDIX  C  (continued) 


PAGE 

24.  OTEST . 225 

25.  UTINT . 227 

26.  ROMBIN2 . 228 

27.  PRITST . 229 

28.  PLFFLD . 231 

29.  GRAPH  . . 235 
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L  PROGRAM  HISTORY! INPUT, OUTPUT, TAPE6»0UTPUT,TAPE13) 

C  THIS  PROGRAM  COMPUTES  FLOW  HISTORIES  AT  SPECIFIED  LOCATIONS 


C0MN0N/C0MFLD/FPARI5),VFPARI5»5),SCD,SCP,SCT,RNIN,RMAX 

COMMON/CFIDEX/EXNUI3) 

/COMFLO/  AND  /CFLDEX/  ARE  SHARED  WITH  REAOFP 


C 

C 

C 

C 

C 


2 

C 


5 


C 

c 


7 

C 

c 


5 


15 

20 


DIMENSION  XI5,100),R! 5,5,100), UTESTI1 00) 

DIMENSION  PARI10),VPARI10,10),TITLE!3),SCV! 10) 

CALL  READAM(SO,SP, ST, TITLE, NBAO) 

READ  AMBIENT  DATA 
IF(NBAD.NE.0.AND.NBAD.NE.3>  STOP 

CALL  READSP(NBAD) 

THIS  RE  AOS  SHOCK  FITTING  RESULTS. THE  PARAMETERS  AND  THEIR 
ACCURACIES  WILL  BE  STORED  IN  THE  PROPER  COMMON  STORAGES 
IF(NBAD.EQ.O)  GO  TO  5 
PRINT  2, NBAO 

FORMAT I1H0,10X, *ERROR  RETURN  FROM  READSP  WITH  NBAD«*»I10> 
STOP 

5  CONTINUE 

CALL  READFP(NBAD) 

READ  IN  PARAMETERS  OF  THE  OVERPRESSURE  FIELD  FUNCTION 
THE  RESULTS  ARE  IN  /COMFLO/  AND  /CFLDEX/ 

IF  (NBAD.EQ.O)  GO  TO  10 
PRINT  7, NBAO 

FORMAT! 1H0,10X,*ERR0R  RETURN  FROM  READFP  WITH  NBAO-*, 110) 
STOP 

10  CONTINUE 

NEXT  EXPRESS  FIELO  PARAMETERS  IN  SCALES  SPECIFIED  BY  READAM 
SCV!  1)»ISCD/S0)**E  XNU  (1)  /  CSCT/ST) 

SC  VI 2) -(SC0/SD)P*(EXNUI1)-1.)/(SCT/ST) 

SC V!  3 ) ■ ISCD/SD) **EXNU !2)/!SCT/ST)**2 
SCV!4>«ISC0/S0>**(EXNU!2>-1. >/ !SCT/ST>**2 
SCV! 5)-!SCO/SO)**EXNU(3)*ISCP/SP) 

DO  20  KA-1,5  S  00  15  KB«1»5 

VPARIKA,KB)«VFPAR!KA,KB)*SCV(KA)*SCVIKB) 

PARIKA)«FPAR1KA)*SCVIKA) 


C 

5  C 

C 

25 

C 

35 

36 


45 


NP-9 

NP  IS  THE  TOTAL  NUMBER  OF  PARAMETERS.  PAR  WILL  BE  SUPPLEMENTED 
IN  FLOFLD  WITH  SHOCK  PARAMETERS 

READ  35,TA,TB,DHIST,TMAX, ANR 
R E AO  AN  INSTRUCTION  CARD  FOR  HISTORY  COMPUTATION 
FORMAT  I 2A10,6E10. 3) 

PRINT  36, TA,TB, DHIST, THAX,ANR 

FORM  ATI 1H1,//,1H  ,10X,*INPUT  READ  BY  HI STORYN AIN*, /, 1H0, 5X, 2 A10, 

A  6!2X,1PE14.7)) 

IFITA.NE.10H  )  GOTO  55 

PRINT  45  t  STOP 

FORMAT! 1HO,10X,*STOP  BECAUSE  FIRST  FIELD  OF  INPUT  CARD  IS  BLANK*) 


55 


PRINT  65 


60 


65 


65  FORMAT ( 1H0, 5X,*THE  CARD  CONTAINS  DISTANCE*  MAXIMUM  TINE  AND*, 

A  *  THE  OESIREO  NUMBER  OF  NODES*,/, 1H  ,5X,*FL0W  HISTORY  WILL** 

B  *  BE  CALCULATED  AT  THE  GIVEN  DISTANCE  AND  UR  TO  THE  MAXIMUM** 

C  *  TIME.*,/,1H  * 5X**C0MPUTING  SCALES  ARE  SPECIFIED  BY  * 

D  »*AMBIENT  OATA  INPUT*) 

PRINT  75 

75  F ORM ATI 1H0, 10X»*THE  PRESENT  INPUT  IS  ASSUNEO  TO  BE  IN  SI  UNITS*) 

RNINS  »RMIN*SCD/SD  $  RMAXS«RHAX*SCO/SD 
DHISTS“OHIST/SD  *  TMAXS*TNAX/ST 
NRHIST-ANR 


CALL  FLOFLD<SD,SP»ST,RMINS*RNAXS»DHISTS,THAXS*PAR,VPAR,NP, 

A  X,R,NRHIST,UTEST»NUTEST,NBAD) 

IF(NBAC.NE.O)  PRINT  85,NBA0 

FORMAT! 1H0, 10X»*ERRR0R  RETURN  FRON  FLQFLD  WITH  NBAD«*,I10,/ 
A/, 1H0»10X,*NEXT  TRY  TO  PLOT  THE  RESULT*) 

75  C  THIS  COMPUTED  ANO  PRINTED  THE  FLOW  FIELD  AT  DHIST 

CALL  PLFFLD ISO, SP» ST,  DHISTS*  X*R*NtHIST.UTEST# MUTEST, T ITLE ) 
C  THIS  PLOTTED  THE  RESULTS  OF  FLQFLD 
GOTO  25 
C 

80  END 


70 


85 
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SUBROUTINE  RE AOAN ( SCO  1ST, SC PRE S, SCT IME* TITL E» NBAD) 

C  THIS  ROUTINE  READS  TITLE »  PLOTLABEL  AND  DATA  CARDS  DESCRIBING 
C  AN 81  ENT  CONDITIONS  ANO  THE  CHARGE 

C  FIRST  TWO  CARDS  ARE  MANOATQRY  ANO  ALPHANUMERIC  (TITLE  ANO  PLOTLABEL 
C  THE  REST  OF  THE  CARDS  HAVE  THE  FORMAT  (2A10*6EI0. 3) 

C  CHARGE  CARD  IS  MANDATORY 

C  IF  AMBIENT  DATA  ARE  NOT  PROVIDED  THEN  STANDARD  AIR  WILL  BE  ASSUMEO 
C 

C  SEQUENCE  OF  MANDATORY  INPUT  CARDS 
C  TITLE  CARO  (ALPHANUMERIC) 

C  PLOTLABEL  CARD  (ALPHANUMERIC) 

C  CHARGE  CARO  -  VOLUME*  ENERGY*  HIGHT*  ERROR  OF  HIGHT 

C 

C  THE  FOLLOWING  ARE  OPTIONAL  INPUT  CARDS  IN  ARBITRARY  SEQUENCE 

C  AMBIENT  *  P* TEMPERATURE*  GAMMA*  MOLAR  MASS 

C  DEFAULT  VALUES  CORRESPOND  TO  A  STANDARD  AIR 

C  SCALES  «  SCALES  OF  R»P,T  TO  BE  USED  IN  COMPUTATIONS 

C  DEFAULT  VALUES  ARE  COMPUTED  AFTER  STATEMENT  1110 

C  PLOTTING  D4TA  *  ERROR  FACTORS  FOR  THE  PLQTTIN6  OF  CONFIDENCE 

C  LIMITS  IN  HISTORY  PLOTS 

C  DEFAULT  VALUES  ARE  FACTORS  2.0  FOR  ALL  PLOTS 

C 

C  END  OF  INPUT  IS  INDICATED  BY  A  BLANK  CARD 
C 

DIMENSION  TITLE( 3) 

DIMENSION  D(8I, AMSTAR(A) 

COMMON/ AMBCHA/AIRPR*  A IRTEM*  AIRGAM*  A IR MOL* CHAR  VO* CH AREN* 

AC HAR HI* CHARHER 
C0MM0N/PL0T/P0(6)*PLABL(4) 

DATAITITL  -10HTITLE  )»  (PLAB-IOHPLOTLABEL  ) 

DATA  (BLANK-IOH  )* ( AMB-10H ANBI ENT  ) 

DATA  (CHA-IOHCHARGE  ) 

OATACPCT* 10HPL0TTING  0),(SCAL«10HSCALES  R*P> 

15  F0RMAT(IHl*l6x*20HlNPUT  READ  BY  READAM*/*1H  *10X*20(lH->*/> 

25  FORMAT ( 8A10 ) 

26  FORMAT! 1H  ,10X,6A10> 

35  FORMAT! 2A10*6E10.3) 

36  FORMAT! 1H  *  5X,2 A10*6 C 2X» 1PE14.7) I 
C 

PDCD-2.0 

C  DEFAULT  VALUE  FOR  PLOTTING  ERROR  LIMITS  IN  PRESSURE  HISTORIES 
PD(2) *2.0 

C  DEFAULT  VALUE  FOR  PLOTTING  FIELD  HISTORIES  (P*V»RHO*V**2*RHO/2.) 

A I RPR *101 325.0  S  AIRTEM-293.0  $  AIRGAM*!. 4 
AIRNOL-O. 02896  S  AIRDEN*! AIRMOL /8 .3143)*! AIRPR/ AIRTEM ) 

C  THESE  ARE  STANOARO  AIR  DEFAULT  VALUES  FOR  AMBIENT  CONDITIONS 

NSCAL-0  $  $UNSTAR*0 
NAMB-0  $  NCHA-0 
DO  37  J*1 *4 
37  AMST  AR( J) *1H 

PRINT  15 
DO  46  KK»  1*  2 
READ  25 « ( 0 ( J ) * J* 1* 8 1 
PRINT  26, (0!J)» J-1,81 
IF(0(1).EQ.TITL  )  GOTO  42 
IF(0( 1) .EQ.PLAB)  GOTO  44 

185 


PRINT  48  %  NBAD-1  %  RETURN 
C 

42  00  43  KA*1,3 

43  TITLE(KA)*0(KAH) 

GOTO  46 

44  DO  45  K A”  1  #  4 

45  PLABL(KA)»0(KA*1> 

46  CONTINUE 
C 

47  READ  35* ( 0 ( J ) * Ja 1»8 ) 

PRINT  36>  (  0  ( J  )>  J  «1>  8  ) 

IF(D(1).EQ. AMB ) GOTO  55 
IF(0( 1).EQ.CHA)G0T0  65 
IF(Dd).EO.PLT)  GOTO  66 
IF(D(1) .EQ.SCAL)  GOTO  68 
IF(D(1).EQ. BLANK)  GOTO  69 

475  PRINT  48  $  NBAD-2  *  RETURN 

48  FORM ATI1H0* 10X» 13HINV  ALIO  INPUT) 

C 

55  IFINAMB.EO.DGOTO  475 

C  ONLY  ONE  AMBIENT  DATA  CARO  WILL  BE  CONSIDERED 
NANB-1 

I F I D ( 3) .GT . 0. )AIRPR*D(3)  $  I F ( D (4 ).GT. 0. ) AIRTEM-D I  4) 
IF(D(5).GT.0.)AIRGAM«0(5)  $  IF < D( 6) . GT . 0. > A I RMOL* D ( 6 ) 

C  IF  INPUT  IS  ZERO  THEN  USE  AIR  DEFAULT  VALUES 
DO  57  KA«1,4  $  AMST AR(KA) *1H 

IFIDIKA+2) .GT.O.)  GOTO  57 
AMSTAR (KA ) » 1H*  t  NA  MST  AR* 1 
57  CONTINUE 

AIRDENa(AIRM0L/8.3143)*(AIRPR/AIRTEN) 

GOTO  47 
C 

65  IF(NCHA.E0.1)G0T0  475 

CHARV0-DI3)  $  CHAREN-DI4) 

CHARHI-0I5)  %  CHARHER-DI6) 

NCHA*1 
GOTO  47 
C 

66  DO  67  K  A*  1 »  6 

67  PD(K A ) *0! KA+2 I 
GOTO  47 

C  PLOTTING  DATA  CARO  SPECIFIES  PLOTTED  OUTPUT 
C  P0(1)«  ERROR  FACTOR  FOR  PRESSURE  HISTORIES 
C  PDI2 ) »  ERROR  FACTOR  FOR  OTHER  FLOW  HISTORIES 
C 

68  NSCAL-1 

S  C  D*  0  (  3 )  l  SCP-DI4)  S  SCT-DC5) 

C  SCALE  CARO  OVERRIDES  SCALES  COMPUTED  FROM  AMBIENT  AND  CHARGE  DATA 
IFISCD. GT. 0.. AND. SCP. GT.O.. AND. SCT. GT.O.)  GOTO  47 
NSCAL-0  \  PRINT  681 

681  FORMAT II H  ,10X» 36HN0N-P0SITI VE  SCALES  ARE  NOT  ACCEPTED) 

GOTO  47 
C 

69  I FINCHA.E Q. 0. OR. NAMB. EQ.O)  PRINT  70 

70  FORMAT! 1H0» 10X, 16HINC0MPLETE  INPUT) 

75  PRINT106, (TITLE! J), J«1.3) 

106  FORMAT! 1H1»/»1H  » 10X» 5HEVENT. / » 1H  »10X,  5I1H- ) , / , 1H0» 15X» 3A10» / /) 


115 


PRINT  107 

107  FORMAT !1H0,10X»18HAMBIENT  CONDITIONS, /, 1H  , 10X, 1 81 1H-), / ) 

IF (N  AHB .E  Q . 0 )  PRINT  1071 

1071  F  ORM AT! 1H0, 10X, 36HTHE  FOLLOWING  AMBIENT  CONDITIONS  ARE, 

A  /,1H  , 10X,27HSTAN0ARD  AIR  DEFAULT  VALUES,/) 

120  PRINT  108, AMSTAR<1),AIRPR, AMST AR( 2 ) , AIRTEM,  AMSTAR!3),AIRGAM, 

A  AMSTARI4), AIRMOL 

108  FORMAT! 1H  , 13X, Al, IX, 8HPRES SURE, 11X, 7HAIRPR  «,1PE12.5,4H  PA,/, 

A  1H  ,13X,  A1,1X, 11HTEMPERATURE, 8X»7HAIRTEM«»1PE12.5>3H  K,/» 

B  1H  , 13X, A1,1X,16HSPEC.  HEAT  RATIO, 3X,7HAIRGAM",1PE12.5,/, 

125  C  1H  , 13X, A1,1X, 10HMQLAR  M ASS, 9X, 7HA IRMOL-, 1PE 12. 5,9H  KG/MOLE,/) 

AIRSND«SQRT!AIRGAM*AIRPR/AIRDEN) 

PRINT  109, AIRSND, AIRDEN 

109  FORMAT ( 1H  , 15X, 11HS0UND  SPE E D» 8X, 7H Al RSND", 1PE 12 .5, 5H  M/S,/, 

A  1H  ,15X,7H0ENSITY,12X,7HAIRDEN*,1PE12.5,9H  KG/M**3,/) 

130  IF(NAMSTAR.EO.l)  PRINT  1081 

1081  FORMAT ! 1H  ,13X,35H*  THE  STARRED  DATA  ARE  STANDARD  AIR, 

A  15H  DEFAULT  VALUES,/) 

IF(NCHA.EQ.l)  GOTO  1100 

135  NBA0-4  $  PRINT  1101, NBAD  S  RETURN 

1101  F0RMAT(1H0,10X, 29HRETURN  FROM  READAM  WITH  NBAD-,12, 

A  33H,  BECAUSE  CHARGE  DATA  ARE  MISSING) 

C 

1100  PRINT  110 

140  110  FORMAT! 1H0, 10 X, 18HCHARGE  DESC R I PTION, /, 1H  ,  10X,  1 8 ( 1H- ) , / ) 

PRINT  111,  CHAR VO»CHAREN 

111  FORMAT ! 1H  , 15X, 13HCHARGE  VOLUME, 6X, 7HCHARV0", 1PE12. 5, 6H  M**3,/, 
A  1H  , 15X, 13PCHARGE  ENERGY, 6X, 7HCHAREN", 1PE12.  5,  3H  J ,/) 

SCDI ST "CHAR VO**! 1./3.  ) 

145  PRINT  111 0, CHARH I, CHARHER 

1110  FORMAT ! 1H  , 15X, 16HCHARGE  ELEVATION, 3X, 7HCHARHI", 1PE12.5,4H  ♦-  , 

A  1PE  12. 5,  3H  M ,/) 

SCTIME" SC OIST/AIRSND 
SCPRES"AIRPR 

150  SCEVEN-CHAREN/ICHARVOPAIRPR) 

PRINT  112 

112  FORM  AT ! 1H0, 10X, 7HSC AL ING, /, 1H  , 10X, 7! 1H-) , / ) 

PRINT  113, SCOIST, SC  TIME, SC PRES, SC  EVEN 

113  FORM  AT! 1H  , 15X, 12HLENGTH  SCALE ,4X,20HSCDIST»CHAR VO**! 1/3) , 

155  A  2X,1H-,1PE12.5,3H  M ,/, 

B  1H  , 15X, 10HTIME  SCALE, 6X,20HSCTIME"SCDIST/ AIRSND, 

C  2X, 1H»,1PE12.5,3H  S ,/, 

D  1H  , 15X, 14HPRESSURE  SCALE, 2X, 13HSCPRES" AIRPR  , 

E  9X»  1H*,1PE12.5,4H  PA,/, 

160  F  1H  , 15X, 14HSCALE  OF  EVENT, 2X, 21HCHAREN/ ICH ARVO* AIRPR ) , 

G  IX, 1H",1PE12.5,/) 

IF!SCEVEN.EQ.O.O)PRINT  114 

114  FORM  AT  1 1H  , 15X, 30HEVENT  CANNOT  BE  SCALED  BECAUSE, 

A29H  CHAREN  IS  NOT  GIVEN  BY  INPUT,/) 

165 

I F IN  SC  AL. E  Q.O )  GOTO  115 

C  USE  SCALES  FROM  SCALE  CARD  IF  SUCH  A  CARO  WAS  READ 
SCDI S  T "SC  0  *  SCPRES-SCP  S  SCTIME-SCT 

170  115  PRINT  116, SCDIST, SCTIME, SCPRES 

116  FORMAT ! 1H  ,////, 1H  , 1  OX, 27HSC ALES  USED  IN  THIS  PROGRAM,/, 


A  1H  f 1 0X>  27llH-)»//»lH  > 20X» 16HLENGTH  SCALE  «,IPE12.5,3H  N »/» 
B  1H  >  20X>  16HTIHE  SCALE  -,1PE12.5»3H  S, /» 

C  1H  » 20X> L6HPRESSURE  SCALE  -tLPE12.5»*H  PA) 

N8AD-0 

RETURN 

END 


188 


t 


} 


o  o  r> 


SUBROUTINE  RE ADSP (N8AD) 

THIS  ROUTINE  READS  SHOCK  PARAMETERS  NAD  THEIR  ACCURACIES 

COMMON/COMSHK/NPS»PAR (  4) »  VP  AR  (  4,  4)  »  SCO,  SC  P»  SC  T 
COMMON/CF2DER/GAMCAP, SNDSPD,CF PAR (4), ALOW»CFSCD»CFSCP»CFSCT 
COMMON/ AM BCHA/ AM P» AMT  »AMG»AMM»  AMCH V, ANCHE , AMCHH, AMCHHE 

DIMENSION  OAT (8 ) »  ER (4 )  »COR ( 4 , 4 ) 

DIMENSION  OSI C4) »DSCC  4) »  DPR ( 4 ) 

DATA( PL»10HSH0CKPAR  ),(EL»10HSH0CKPARER), I CL» 10HSHQCKPARC0) 
A  (SC*10HSH0CKSCAIE)»<BL«10H  ) 

DATA  DS 1/ 10HPA4N  ,1DHPA*M**2  ,10HPA*M**3  » 

A  10HS  / 

DATA  DSC/ 10HSCP*SCD  ,10HSCP*SCD**2» 10HSCP*SCD**3, 

A  10HSCT  / 

KPL*1  S  KEL*1  $  KCL=1  $  KSC»1 
PRINT  12 

FORMAT( 1H1,10X»2 OH  INPUT  READ  BY  READSP,/) 

FORMATt 2A10*6E10.3» 

FORMAT ( 1H  #5X»2A10»6C2X»1PE14.7)) 

READ  15,(DAT(J), J*l,8 ) 

PRINT  25,  C  DAT  (J) ,  Jml»  6  ) 

IF  (D  AT(  1)  « EQ.PL )  GOTO  55 
I F (OAT ( 1) • EO.EL )  GOTO  75 
IF (OAT( 1) • EQ,CL )  GOTO  95 
IF(DAT(1).EQ.SCI  GOTO  115 
IF  (0  AT  1 1) . EO.BL)  GOTO  125 
NBAO-1 

PRINT  45  $  RETURN 

FQRMAT(1H0,10X,13HINVALID  INPUT) 


DO  65  KA«1,4 
PAR(KA)»DAT(KA*2) 

D ALOW»D AT C  7 ) 

IF(DAL0W.GE.1.0E-90)  GOTO  67 
PRINT  66,  DAT (  6) 

FOR  NAT (1H  ,10X,»5-TH  NUMBER 
A  'POSITIVE  INDICATING  SHOCK  C 
NBAD-66  $  PRINT  45 
RETURN 
CONTINUE 
KPL*0 
GOTO  35 


ON  PREVIOUS  CARD  SHOULD  BE 
DISTANCE  AT  T«'1PE12.5) 


DO  85  K A*  1 , 4 
ER(KA)«0AT(KA*2) 
KEL>0 
GOTO  35 


C  0R( 1, 1  )* 1 .  $ 

COR( 1,2 )»OAT( 3) 
C  0R( l  »  3 1  =  D AT  <  4 ) 
C  0R( 1,4)-0AT(5) 


C0R«2f2)»i.  %  C0R(3,3)»1. 

t  COR( >,1)»C0R(1,2) 

\  C  0R<  3,  1 )  »C  OR  C 1, 3 ) 
i  C0R(4,1)*C0R(1,4) 


$  COR ( 4»  4  I « 1 < 


CORC 2,3)«0AT!6)  $  COR!  3?2  ) -COR!  2?  3) 

COR( 2?  4  )*  DAT! 7)  S  C OR( 4 ? 2 ) *COR! 2? 4) 

COR< 3?4 > - 0  A  T ( 8  »  $  C0R!4?3)*C0R!3?4) 

KCL«0 
GOTO  35 
C 

115  SCD*DAT!3)  S  SCP«DAT!4)  *  SCT-DAT!5) 

KSC«0 
GOTO  35 
C 

125  IF1KPL.EQ . 0. AHD.KEL. EO.O.AND.KCL.EO.O.AND.KSC.EQ.O)GOTO  145 

N  B  AD  ■  2 

PRINT  135  *  RETURN 

135  FORMAT! 1H0?10X?16H INCOMPLETE  INPUT) 

C 

145  NPS»4 

ALOW*OALOW*SCD 

G AMC  AP« ! ! 1 . ♦  AMG ) / 1 2 • *  AMG  ) l/AMP 
S  NOS  PO* SORT ( AMG* AMT*! 8*3143/AMM)) 

CFSCO-1.  $  CFSCP-1.  $  CFSCT-1. 

C  /CF2DER/  IS  NEEDED  FOR  SHOCK  ARRIVAL  TIME  COMPUTATIONS 
DO  155  KA-1>4  $  DO  155  KB«1?4 

155  VPARlKA,KB)«ER!KA)*COR!KA?KB)*ERiKB> 

NBAD-0 
PRINT  165 

165  FORMAT!  1H0?12X?1 6H SHOCK  PARAMETERS? 4Xy6HERR0RSy5Xy 
A  lOHDIMENSIONSy/l 

IF(SCD.EQ.1..AND.SCP.EQ.L.. AND.SCT.EQ.l. )  GOTO  167 
DO  166  KA-ly4 

166  DPR!KA)-DSC!KA) 

DI SO  I  * 10H  SCO 
GOTO  169 

167  00  168  KA" iy  4 

168  DPR!KA)*DSI!KA) 

DISDI-10HMETRES 

169  PRINT  175y ( !PAR!J)?ER!J)?OPR!J  ))?J*1?4) 

175  FORMAT ( 1H  , 14X? 1PE12. 5?4X?1PE10.3?2X? A10) 

PRINT  178yDAL0WyDISDI 

178  FORMAT! lHOylOXy43HTHE  LAST  PARAMETER  IS  SHOCK  ARRIVAL  TIME  ATy 
A  2X?1PE12.5?2X,A10) 

PRINT  185 

185  FORMAT ! 1H  ?///?lH  ,15X?*SH0CK  PARAMETER  CORRELATION  MATRIX*? / ) 
PRINT  195? 1 !C0R!4?K)?K«1?4) ?  J  «1?4 ) 

195  FORMAT ( 4! 1H  ? 10X? 4 1 2X ? 0PF10. 7 ) ? / )) 

PRINT  205 

205  FORM  AT ! 1H  ?///?lH  y 15 X? 16HSH0C K  PARAMETER  ? 

A  26H VARIANCE-COVARIANCE  MATRIX?/) 

PRINT  215? ! IVPAR!4?KJ?K»1?4)?J*1?4) 

215  FORMAT  1 4! 1H  ? 10X? 4 1 2X? 1PE 12 . 5  )  ? / ) ) 

PRINT  225 

225  FORMAT! 1H  ?///?lH  ? 16X?22HSH0CK  PARAMETER  SCALES?/) 

PRINT  235? SCOySCP.SCT 

235  FORMAT ( 1H  ? 15X? 12HLENGTH  SCALE?4X?5HSCD  -?1PE12.5?3H  My/? 

A  1H  ?15X? 14HPRESSURE  SCALE? 2X? 5HSCP  •?1PE12.5?4F  PA?/, 

8  1H  ? 15X? 10HTIME  SC AL  E?6X,5HS ‘T  »?1PE12.5?3H  S) 

RETURN 

END 
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5 
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45 
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SUBROUTINE  RE  ADF  P ( N8 AD ) 

C  THIS  READS  OVERPRESSURE  FIELD  FUNCTION  PARAMETERS 

C 

C0MM0N/CFL0EX/EXNU13) 

C0NN0N/C0NFLD/FPARI5) ,VFPARI5, 5 ) » SC D, SC P, SCT» RMI N,RM AX 
C  /COMFLD/  IS  AVAILABLE  TO  THE  (IAIN  PROGRAM 
C 

DIMENSION  DAT(8)»ER(5  I  »  COR ( 5»  5  J 
DIMENSION  DIMA15)*0IMBI5) 

C 


1 


C 


12 

15 

25 

35 


38 


45 


55 

65 

75 

85 

95 


115 


116 


120 


DATA! FP-10HFIEL0PAR  ) » ( FE-10HF IELDPARER » » I FS-10HFIELDP ARSC » 
»( FC*10HFIEL0PARC0)»  I  BL*10H  ) 

DATAIEX*10HFIELDPAREX)»IRA*10HFIELDPARRA) 

DATA  IC0R1-10H  1  >,IC0R2*10H  2  ) 


PRINT  12 

F0RNATI1H1»10X**INPUT  READ  BY  RE ADF  P*» / ) 
F  ORM AT (2A10>6E10.3) 

FORM  ATI 1H  >  5X,2A10»6( 2X»1PE14.7) ) 

READ  15>I0ATIJ)»J*1»8 ) 

PRINT  25,10ATIJ),J*1,8) 

IF(DATIl) .EO.FP)  GO  TO  55 
IFIOATI 1) .EQ.FE)  GO  TO  75 
IFIDATIU.EQ.FS)  GO  TO  95 
IFIDATID.EQ.FC)  GO  TO  115 
IFIDATIl) . EQ . BL )  GO  TO  125 
IFIDATIll. EQ. EX)  GO  TO  135 
IFIDATUI  .EO.RA)  GOTO  145 
N  8  AO  *  1 
PRINT  45 

FORM  ATI 1H  » 10X»*INVALID  INPUT*) 

RETURN 


DO  65  KA»1,5 

FPARIKAI-DATIKA+2) 

CONTINUE 

GO  TO  35 

DO  85  K  A*  1 »  5 


ERIK A)-0ATIKA*2) 

CONTINUE 
GO  TO  35 

SCO* DAT  13 1  5  SCP-DAT14)  *  SCT-DATI5) 

GO  TO  35 

IFIDATI2I.EQ.C0R1)  GOTO  116 
IFIDATI2I.EQ.C0R2)  GOTO  120 
GOTO  38 

CORI 1> 1 )*1.  S  C0RI2»2)*1.  $  CORI3»3)*l. 
C  ORI 4»  4 ) ■ 1  •  $  COR  I 5»  5 1*1. 

C  OR! 1»  2 ) *D AT  I  3 )  $  COR  I 2» 1 ) • DAT  I  31 
$  COR  I 3» 1 ) *OAT 1 4 1 
$  COR  14*1) -DAT  I  5 ) 

*  COR I 5» 1 )*DAT (61 
i  COR  I 3»  2 ) *DAT 1 7 ) 


CORI l»  3I-0ATI4I 
CORI 1,4)-DATI5) 
CORI 1,5)-DAT<6) 
CORI 2,3)»DAT17> 
GO  TO  35 
CORI 2»4)*0ATI3) 
CORI 2 »  5 ) *DATI 4) 
CORI 3»4)»DATI5) 


%  COR  1 4» 2 ) *D AT  13) 
J  COR  I 5» 2 ) *DAT 14) 
$  C  OR l 4»  3 ) *OAT I  5 ) 
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60 


65 


70 


75 


80 


85 


90 


95 


100 


105 


110 


CORI 3, 5 ) =D AT ! 6)  $  COR < 5, 3 ) * DAT ( 6) 

C  OR!  4 , 5 )*OAT! 7)  $  COR ( 5, 4 > « DAT (7 ) 

GO  TO  35 

135  00  160  KA*1,3 

EXNU!KA)*DAT1KA*2) 

160  CONTINUE 
GO  TO  35 

145  RMIN*DAT<3)  $  RMAX*DATI4) 

GOTO  35 

C 

C  ENTER  125  WHEN  BLANK  CARD  INDICATES  END  OF  DATA 
125  DO  155  KA*1»  5 
DO  155  KB= 1 , 5 

VFPAR1KA, KB)»ER!KA)*CORIKA,KB)*ERIKB) 

155  CONTINUE 
N  B  AD*  0 

C  NOW  PRINT  COMPREHENSIVE  LIST  OF  INPUT 
PRINT  165 

165  FORMAT (140»12X>16HFIELD  PAR AMETERS, 3X, 10HSTD. ERRORS, 4X, 

A  10HDIMEN SIGNS,/ ) 

DIMA!1)*10HM**EXA/S  $  DIMB!1)*10H 
DIMA12)“10HM**!EXA— 1)  %  OIMB! 2)*10H/S 

OIMA<  3)»10HM**EXB/S***  DIMB!3)*10H2 
DIMA ( 4) *10HM**I E  XB-1 )  *  OIMB! 4)-10H/S**2 

DIMA! 5)«10HM**EXC*PA  $  DIMB15)*10H 
IFISCT.EQ.l.. AN0.SC0.EQ.1..AND.SCP.EQ.1. )GOTO  168 
0IMA!1)«10HSCD**EXA/S  %  OIMB! 1)«10HCT 
D I MA 1 2 ) *1  OH  SC  D** ! EX A-  t  DI MB ( 2 ) * 10H1 ) / SCT 
DIMA! 3)*10HSCD**EX8/S  S  DIMBI3)»10HCT**2 
DINA!4)«10HSCD**!EXB-  *  OIMBI 4) -10H1 ) / SCT**2 
D IMA  I  51*1 OH$CD**EXC*S  %  OIMBI 5)*10HCP 
168  CONTINUE 

PRINT  175, I IFPAR! J),ERIJ)»DIMA1J),DINB! J) ), J-l, 5) 

175  FORMAT  I 1H  ,  14X,  1  PE  1 2 . 5, 4X, 1  PEI  0. 3, 4X, 2A 10 ) 

PRINT  178 , RMIN, RMAX 

178  FORMAT! 1H0, 12 X, 34HTHE  PARAMETERS  CAN  BE  USED  BETWEEN, 

A  6H  RMIN*, 1PE12.5,10H  AND  RMA X*, 1  PE  12. 5  I 
IFISCD.EO.l.JPRINT  1781 

1781  FORMAT!  1H*»86X,7H  METRES  I 
IFISCD.NE.l.) PRINT  1782 

1782  F0RMAT!1H*,86X,4H  SCO) 

PRINT  180 

180  FORMAT! 1H0, 12 X, 3 9H EXPONENTS  IN  OVERPRESSURE  FIELD  FORMULA,/) 
PRINT  182,EXNUil),EXNU!2),EXNU!3) 

182  FORMAT ! 1H  ,15X,5HEXA  *,F12.2,/,1H  ,15X,5HEXB  *, 

A  F12.2,/,1H  ,  15X, 5HEXC  *,F12 .2,/) 

PRINT  185 

185  F0RMAT11H  ,  /,1H  ,15X,*FIELD  PARAMETER  CORRELATION  MATRIX*,/) 

PRINT  195, 1 (COR!J,K),K*l,5),J*l,5) 

195  F  ORM  AT! 5! 1H  , 10X , 5 1 2X , F 10. 7 ) ,  /  )  ) 

PRINT  205 

205  FORMAT ( 1H  ,///,lH  ,15X,*FIELD  PARAMETER  *, 

A  *VARIANCE -COVARIANCE  MATRIX*,/) 

PRINT  215,1 !VFPAR!J,K),K«1,5),J*1,5) 

215  F  ORMA  T! 5! IH  , 10X , 5 ! 2X , 1PE 12 . 5 ) , / )  > 

PRINT  225 

225  F  ORM  AT  1 1H  ,///,lH  ,16X,*FIELD  PARAMETER  SCALES*,/) 
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PRINT  235* SCO»SCP»SCT 

235  F0RNATC1H  » 15X*12HLEN6TH  SCAIE*4X*5HSC0«  *1PE12.5»2H  N»/> 
A  1H  * 15X* 14HPRESSURE  SCALE*2X* 5HSCP-  »1PE12.5*3H  PA*#* 

B  1H  * 15X* 10HTIHE  SC ALE*6X* 5HSCT-  *IPE12.5*2H  S> 

RETURN 


nnonrtnoonoonoooonorinoonnno 


SUBROUTINE  FLOFLDI SC0»SCP* SCT* RMIN»RNAX»R, TMAX, PAR, VPAR, NPAR* 

A  HIST, VH 1ST* NHIST, UTS T* NUTS T,N BAD) 

THIS  IS  CALLED  FROM  MAIN  TO  CONFUTE  THE  FLOW  HISTORY  A  THE 
OISTANCE  R  AND  FOR  TIMES  BETWEEN  SHOCK  ARRIVAL  AND  TMAX 

SCO*  SCP, SCT  -  SCALES.  ALL  ARGUMENTS  ARE  IN  TERMS  OF 

THESE  SCALES 

RMIN*RNAX  -  RANGE  OF  PRESSURE  FIELD  APPROXIMATION  . 

R»  TMAX  >  OISTANCE  AND  ENO  POINT  OF  HISTORY 

PAR* VPAR* NPAR  »  PARAMETERS  OF  PRESSURE  FIELD  FUNCTION 

PFIELD  AND  VARIANCES  OF  THE  PARAMETERS.  PAR  AND 
VPAR  WILL  BE  SUPPLEMENTED  BY  SHOCK  PARAMETERS  AND  THEIR 
VARIANCES.  NPAR  IS  IGNORED  AND  SET  EQUAL  TO  9. 

NHIST  -  NUMBER  OF  NODES  TO  BE  COMPUTED.  IT  WILL  BE 

REPLACED  BY  ACTUALLY  COMPUTED  NODES. 

THE  FOLLOWING  WILL  BE  COMPUTED  BY  THIS  ROUTINE 

HIST 1 5, NHIST )  »  FLOW  FIELO  HISTORY  (T*P»R,U» RHO»O.5*U**2*RH0I 

VHISTI5,5,NHIST)  •  VARIANCE-COVARIANCE  MATRICES  OF  HIST 

NHIST  >  NUMBER  OF  HISTORY  NODES  COMPUTED 

UTSTINUTST)  -  PARTICLE  VELOCITIES  COMPUTED  BY  TEST  PROCESS 

NUTST  >  NUMBER  OF  TEST  VELOCITIES  IN  UTST 

NB AD  -  ERROR  INDICATOR 

ROUTINE  USES  SUBROUTINES  STRBEG,  STRLIN  ANO  FLINTER 

EXTERNAL  PFIELO 
C  PRESSURE  FIELO  FUNCTION 
C 

DIMENSION  P AR I 10) » VPAR I 10*10) *  HIST! 5» 100) ,  VHIST ( 5*5* 1001* UTST ( 100 ) 
C 

DIMENSION  SOL  INI  6)* TP  INI 10) *XPP( 10) »UPP I10)»UPTPI10),DPINI10) 
DIMENSION  STRNUI 6* 200 )» VSTRNUI 6*6*200) *STR0LI6» 200) *VSTR0LI6*6* 200 
1) 

C 

CQMM0N/AI'.3CHA/APRE*  ATEM*  AGAM*  AMOl»CHVOL  »CHENE»CHHIG»  ECHHIG 
COMMON/CSC ALE/SCOI* SC  PR, SCT I 

COMM ON /COM SHK /NPSH»P ARSHI 6) * VPARSHI A*  4) *  SCDSH*  SC  PSH*  SCTSH 
C 

SCDI »SCD  l  SCPR-SCP  $  SCTI-SCT 

C  THESE  SCALES  ARE  NEEDED  IN  OFUNCT  WHICH  IS  CALLED  FROM  PFIELD 
C 

C  NEXT  SUPPLEMENT  PAR  AND  VPAR  WITH  SHOCK  PARAMETERS 
DO  8  KA-6,8 

PARI  KA) *PARSHIKA— 5 )♦! SCPSH/ SCP  )*( SCOSH/SCD)** I K A-5) 

VPARI KA*9)«VPARSHIKA— 5*4) *t SCTSH/SCT)*! SCDSH/ SCO)** IK A-5) 

A  4ISCPSH/SCP) 

VP AR I 9* KA)* VPAR IK A* 9) 

DO  8  KB-6*8 

VPARIKB,KA)«VPARSHIKB-5,KA-5)* ( SC PSH/ SC P) 4*2 
A  * (S COSH/SC D )** t KA^KB— 10) 

8  CONTINUE 

PARI 9)«PARSHI4)*SCTSH/SCT 

VP AR 1 9, 9)> VP ARSHI 4*  4) *ISCTSH/SCT)P*2 

DO  9  KA-1,5  t  DO  9  KB-6,9  S  VP ARIKA*KB) >0 


9  VPAR ( KB*KA ) -0 
NPAR-9 

THIS  PROGRAM  ASSUMES  5  PRESSURE  FIELD  PARAMETERS  AND 
A  SHOCK  PARAMETERS 

N  B  AD  *  0 

IF(NHIST.GE.l)  GOTO  12 

N BAD* 11  $  PRINT  14*  NBAO 

PRINT  16  $  RETURN 

FORM  AT  1 1H*» 45X» ' »  BECAUSE  NHIST-O' > 

12  IF(O..LT.RMIN.ANO.RMIN.LE.R.ANO.R.LE.RMAX>  GOTO  15 
NBAD-13  S  PRINT  14*  NBAD 
PRINT  17  S  RETURN 

FORMAT ( 1H*» 45X» ' »  BECAUSE  RM1N*  RHAX*  R  ARE  OUTSIDE  RANGES') 

14  FORMAT! 1HO* 10X» 29HRETURN  FROM  FLOFLD  WITH  NBAD-*I5) 

15  NHMAX-NHIST 
AIRPRSC-APRE/SCP 

SCALEO  AIR  PRESSURE  IS  NEEDED  BY  STRLIN 
RINNU-R  *  NHIST-1 
SET  TO  COMPUTE  FIRST  HISTORY  NOOE 
25  SOLINC3I-RINNU 

CALL  STRBEG(SQLIN»TPf N»XPP* UPP»UPTP»DPIN*LBAO t 
THIS  COMPUTES  INITIAL  POINT  OF  STREAMLINE 

S0LIN(6)  -  FLOW  VARIABLES  IT* P* R*U»RH0,0.54U**24RH0> 

TPIN(IO)  -O/DPAR  OF  INITIAL  TINE  SOLINC1) 

XPP(IO)  -D/DPAR  OF  THE  INITIAL  POSITION  SOLINC3) 

UPP(IO)  -D/OPAR  OF  THE  INITIAL  PARTICLE  VELOCITY  S0LINI4) 

UPTPCIO)  -D/DPAR  OF  THE  INITIAL  PARTICLE  ACCELERATION 

DP  IN ( 10 )  -AN  EXPRESSION  OF  DERIVATIVES  NEEDED  BY  STRLIN 

LB AD  -  ERROR  INDICATOR.  LBAD.NE.O  IF  ERROR  RETURN  FROM  STRBEG 


IF(LBAO.EO.O)  GOTO  35 

34  NBAO-34  t  PRINT  14*  NBAD  S  RETURN 

35  THAXS-AMAXMTMAXtSOLINdl ) 

NSTRNU-200 

0 TNU- SOLI N( 11/100. 

DEFAULT  DT  FOR  ONE-NODE  STREAMLINE  COMPUTATION 
NODE S -MIN 0(NSTRNU-1*NAX0( NHMAX»20I ) 

I F (TMAXS. GT . SOL IN( 1 ) ) DTNU- ( TMAXS— SOLINC 1 ) ) /FLOAT (NOD ES-1) 

CALL  STRL IN(TMAXS*AIRPRSC*AGAM*PFIELD*PAR»VPAR*MPAR*SOLIN» 

A  TPIN»XPP»UPP#UPTP*DP IN*DTNU»  STRNUt  VSTRNU*  NSTRNU*  LBAOI 

THIS  COMPUTES  A  STREAMLINE  STARTING  AT  SOLIN  AND  ENDING  AT  TMAXS 

TMAXS  «  END  POINT  OF  STREAMLINE 

AIRPRSC  -  AIR  PRESSURE 

AGAM  -  GAMMA  OF  AIR 

PFIELD  «  PRESSURE  FIELD  FUNCTION 

PAR»  VPAR»NPAR  •  PRESSURE  FIELD  PARAMETERS?  VARIANCES*  NUMBER 

SOLIN  THROUGH  DPIN  ARE  PASSED  FROM  STRBEG 

DTNU  •  DELTA-TIME  TO  BE  USEO  FOR  INTEGRATION 
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C  STRNU(6» 200)  »  STREAMLINE  FLOW  VARIABLES  (T»P*R#U*RHO#OP) 

C  VSTRNU!  6*6*200)  -  VARIANCE-COVARIANCE  MATRICES  OF  STRNU 
C  NSTRNU  «  NUMBER  OF  NODES  IN  STRNU.  INITIALLY  IT  SHOULD 

C  BE  SET  EQUAL  TO  THE  MAXIMUM  DESIRED 

C  LB  AO  -  ERROR  INDICATOR.  LBAD.NE.O  IF  ERROR  RETURN 

C 

IF(LBAD.EQ.O)  GOTO  *8 
46  N BAD *46  $  PRINT  14*  NBAO  S  RETURN 
48  IF (NHIST. GT.l )  GOTO  65 

C  BRANCH  AFTER  FIRST  NOOE.  ELSE  OELTR  MAY  BE  ESTABLISHED 
IF(TMAX.LE.STRNU(1»1> »  GOTO  55 
IF(NHHAX.EQ.l)  GOTO  55 

C  BRANCH  IF  THIS  WAS  A  ONE-NODE  CALCULATION 

RHOZSC* (ANOL/8.3143)* ( APRE/ ATEN)* (SCD/SCT 1**2/ SCP 
DTHI ST* UMAX— STRNU U»  1 )  I/FLOAT  (NHMAX-ll 
C  THIS  IS  OELTA-TIME  FOR  HISTORY 

DELTR* DTHI ST* STRNU! 4»1)*STRNU(2»1)/ (STRNU (2* 1 )-RHQZSC*STRNU( 4* II*' 
12) 

C  DISTANCE  DECREMENT  FOR  SUBSEQUENT  STREAMLINES 

C  THE  SECOND  STREAMLINE  WILL  CROSS  R  AT  ABOUT  STRNU! 1*1) ♦DTHIST 

C 

C  NOW  STORE  CALCULATED  FIRST  NOOE 

55  DO  57  KA*1»5  $  00  56  KB-1,5 
KC-KA  t  IF!KA.GT.2)KC*KA*1 
K0*K8  S  IF(KB.GT.2)K0*K8*1 

56  VHIST (KA*  KB»1)*VSTRNU (KC*K0*1 ) 

57  HIST! KA»1 ) -STRNU !KC» L ) 

I F (NHMAX. EQ.1.0R.TMAX.LE.HIST(1*1>)  GOTO  145 
C  RETURN  IN  ONE-NODE  HISTORY  CASE 
C 

RINOL-RINNU  l  RINNU-R INOL-OELTR 
DRSIGN-1. 

GOTO  100 

C  BRANCH  TO  STORING  OF  STRNU  IN  STROL  AND  NEXT  STREAMLINE 
C 

65  TIME-HIST!  l.NHIST-D  +  DTHIST 
TINE-ANINKTINE.THAX) 

C  ENTER  65  FROM  48.  NOW  STROL  CONTAINS  OATA. 

C  ALSO  LOOP  TO  65  FROM  88 
C 

CALL  FLINT ER( TIME *R»H 1ST*  VH I ST»NHIST» STROL* VSTROL»NSTROL» 

1  STRNU* VST RNU*N STRNU* DRSIGN.KBAO) 

C  THIS  INTERPOLATED  BETWEEN  STROL  AND  STRNU  AND  STORED 
C  RESULTS  IN  HIST(...»NHIST). 

C 

73  IF(KBAD.NE.99)  GOTO  75 
NHlS  T-NHIST— 1 
GOTO  95 

C  BRANCH  TO  CALCULATION  OF  NEXT  STREAMLINE  INSTEAD  OF  USING  EXTRAPOLATED 
C  VALUE 

75  IF(KBAD.EQ.O)  GOTO  85 
77  NBAO-77  S  PRINT  14*  NBAO  S  RETURN 
85  IF(HIST(l*NHIST>.GE.TMAX-DTHIST*0.n  GOTO  145 
C  THIS  IS  REGULAR  RETURN  AFTER  REACHING  TMAX 
C 

NHIST*NHIST*1 
88  GOTO  65 


95  RINOL  -RINNU  *  RINNU-RINOL  -DE LTR*DRS IGN 
ENTER  95  FROM  73  AND  GET  NEXT  STREAMLINE 
100  RINNU-AMAX1!RINNU*RMIN)  $  RINNU-AHIN1!RINNU»RHAX » 
IF1RINNU.NE. RINOL  )  GOTO  115 
NESS-1  *  GOTO  155 

105  FORMAT! 1H0* 10X* 5HTHAX-* 1FE12*  5* 19H  CANNOT  BE  REACHED* 

A33H  BECAUSE  OF  RESTRICTIONS  BY  RHIN-* 1PE12. 5, 11H  AND  RHAX-. 
B  1PE12.5W) 

115  00  125  KA-1*NSTRNU 
NOW  STORE  aD  STREAMLINE 

DO  122  KB-1»6  t  DO  120  KC-1»6 
120  VSTROL!KC*KB*KA)-VSTRNUIKC#KB*KA) 

122  STRQL!KB*KA)-STRNU!KB»KA) 

125  CONTINUE 

NSTROL-NSTRNU 
NHIST-NHIST*1 
GOTO  25 

145  NESS-0 

ENTER  145  FROM  85  FOR  REGULAR  RETURN 
155  CALL  PRIHIS1R»HIST* WHIST#  NHIST) 

IF!NESS.E0.1)PRINT  105*TNAX»RHIN#RMAX 

CALL  UTES T! SCO#  SCP*  SCT»RMIN#RHAX»R» TNAX*  PAR»VPAR#NPAR# 

A  HIS T* VHI S T* NHIST* UTS T»NUTST*L BAD) 

CALL  FRITST!R#RMAX#HIST#VHIST#NHIST»UTST#NUTST) 
IF!LBAD.NE.O)PRINt  165*LBAD 
165  FORMAT! lHO»10X*12HLBAO(UTEST)-» 15) 

RETURN 
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SUBROUTINE  STRBEG! SOL IN» TPIN, XPP, UPP» UPTP» DPIN. NBAD > 

THIS  COMPUTES  THE  INITIAL  STREAMLINE  NODE  ON  THE  SHOCK  ANO  ITS 
ACCURACY.  THE  SOLIN  COMPONENTS  ARE 
(T »  P,  R»  U»  RHO>  U**2*RHQ/2 ) 

THE  GIVEN  ARGUMENT  IS  THE  SHOCK  DISTANCE  R*SOLIN!3>. 

R  IS  ASSUMED  TO  BE  CONSISTENT  WITH  THE  SCALES  IN  /CSCALE/ 

TP  IN#  XPP#UPP»UPTP  AND  DPIN  ARE  INITIAL  STREAMLINE  VARIABLE 
DERIVATIVES  WITH  RESPECT  TO  THE  PARAMETERS 

ROUT I NR  USES  F2SHCK 

DIMENSION  SOLIN!6)*TPIN(iO)»XPP! 10) »UPP( 101 »UPTP tlO)#DPIN(10) 
DIMENSION  X!5»1)»PAR! 10)»FX!5)»FP!I0)»FXX!5»5)»FXP(5»10)» 

A  FPP ( 10#10)#S0LMAT ( 6#  4)# SCALE! 4) 

C 

COMMON/CSC  ALE /SC D»SCP»SCT 

COMMON/CF 2DER/GAMCAP#  SN0$PD»CPAR!4)» ALOW»SCOC»SCPC# SCTC 
CONMON/AMBCHA/PZ#  TZ»GZ« ANZ»  VCH» ENCH» HCH#  EHCH 
COMNON/COMSHK/NPS#  PARS!4)#VPARS14#4)»$CDS»$CPS»SCT$ 

C 

DO  25  KA*1»3 

25  SCALE IKA) *!SCPS/SCP)*1 SCDS/SCD )**KA 

SCALE!4)*SCTS/SCT 

DO  45  KA-1,4  S  PAR! KA )■ SCALE! KA )* PARS (K A > 

45  CPAR!KA)-PAR!KA) 

C  THE  NEW  PARAMETERS  ARE  SCALED  ACCORDING  TO  /CSCALE/ 

C 

SNOSPD-SNDSPD*!SCT/SCTC)*!SCOC/SCD) 

G AMC  AP»GAMC AP*( SC P/ SC PC  I 
ALOW*  ALOW 4 1  SC OC/ SCO) 

SCOC-SCD  $  SCPC-SCP  S  SCTC-SCT 
C  THIS  TRANSFORMED  /CF2DER/  INTO  /CSCALE/  UNITS 
C 

R-S0LIN13) 

C  NEXT  COMPUTE  SHOCK  ARRIVAL  TINE 

Xil»l)«0.  S  X!2» 1)*R  $  X!3#l)*0. 

CALL  F2SHCK!X»1#PAR»F»FX»FP»FXX»FXP»FPP»NBAD) 

IF !NB AD.NE • 0)  RETURN 
C 

POV-! !PAR(3)/R4PAR(Z) )/R*PAR!l> )/R 
USH*SNDSPO*SORT!1.*GAHCAP*POV) 

C  SHOCK  VELOCITY 

R0SI«IAMZ/8.3143)*!PZ/TZ) 

C  ROSI  IS  AMBIENT  OENSITY  IN  SI  UNITS 
RAMB*R0SI*!SC0/SCT)**2/SCP 
C  AMBIENT  DENSITY  IN  /CSCALE/  UNITS 
C 

UPSH*POV/ ! RAMB4USH I 
C  PARTICLE  VELOCITY  AT  THE  SHOCK 

GAHTIL-!!GZ-1.)/!2.*GZ*PZ))*SCP 

R0SH*RAMB«!1.4GAMCAP*P0V)/!1.4GAMTIL4P0V) 

C  DENSITY  AT  THE  SHOCK 

DPSH»UPSH**2*R0SH*0.5 

C  DYNAMIC  PRESSURE  AT  THE  SHOCK  !*SPECIFIC  KINETIC  ENERGY) 

SOLIN! 1)*F/SNDSP0 
SOLI N! 2)*P0V 


SOLIN!*>«UPSH 

SOLIN!5»-ROSH 

S0LIN!6)«DPSH 

C 

C  NEXT  COMPUTE  INFLUENCE  MATRIX  SOLMAT  WHICH  EXPRESSES  THE 
C  RELATION  BETWEEN  SQLIN  ANO  THE  PARAMETER  VARIANCES  VPARS 
DUN-1 •♦6ANCAP*P0V 

UPFAC  T-UP  SH*! l./POV— 0 •5*GAMCAP/0UHI 
ROFACT-1.  /(SNDSPDP*2*0UM*Cl.*6AMTIL*P0Vn 
DPFACT-!UPSH**2*R0FACT*2.*UPSH*R0$H*UPFACTI*0.5 
DO  65  KA-1»3 

65  S0LMAT!2»KA)-1./R**KA 

S  OLN AT  !  2»  4 1  -0» 

00  75  KA-  1»  4 

SOLMAT  < If KA )-FP! KA) /SNDSPD 
SOLMAT!  3,KA)-0. 

SOLMAT! 4»KA)-UPFACT*S0LMAT!2»KAI 
SOLMAT! 5»KAI-ROFACT*SOLNATI2*KAI 
75  SOLNATI6»KA)-DPFACT*SOLHAT!2»KA) 

C 

DO  105  KA-1#10  *  XPPIKAI-0  $  UPP!KA)-0  *  TPIN!KA)-0  *  0PIN1KAI-0 
105  UPTP1KAI-0 

POVR  — !!3.*PAR(3)/R*2.*PAR12»)/R*PARI1»»/R*62 
UPT—  POVR/ROSH 

C  DU/DT  OF  PARTICLE  VELOCITY  AT  SHOCK 
DO  115  KA-1,3 
TPIN (KA*5) -SOLMAT! 1»K A) 

DPIN I KA+5 )-(R0FACT/R0SH-l./!6Z*!P0V*PZ/SCPl) )*S0LNAT!2»KA t 
UPPI KA*5) -SOLMAT !4,KA) 

115  UPTP ! KA*5I -UPTP1—S0LMAT! 5*KAI/R0SH»FL0AT!~KA) 71 R*6!KA»1I*P0VRI I 

T PIN! 9) -SOLMAT! 1# A) 

RETURN 
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SUBROUTINE  STRL INC  TNAX* AIRPR*  AIRGAM » PFIELD* PAR*  VP AR*  NPAR*SOLIN» 

A  TPIN*  XPP* UPP*UPTP*  DP IN»DT»SLINA* VSLINA*NNAXA* NBAD) 

C  THIS  COMPUTES  A  STREAMLINE  STARTING  WITH  SPECIFIED  INITIAL 
C  VALUES  AND  ENDING  AT  TNAX 
C 

C  TM  AX 
C 

C  A I  RPR 
C  AIRGAM 
C  PFIELD 
C  PAR* VPAR*NPAR 
C  S0LINC6) 

C 

c 

C  TPIN(IO) 

C  XPP(IO) 

C  UPP(IO) 

C  UP TP ( 10 ) 

C  DP  IN  <  10  I 
C  DT 
C 

C  THE  FOLLOWING  WILL  BE  COMPUTED  BT  THIS  ROUTINE 
C 

C  SL INAC6*  NNAXA)  *  FLOW  VARIABLES  ALONG  THE  STREAMLINE  (T*P*R*U*RHO»U 
C  VSLINAC6»6*NNAXA1-  VARIANCE-COVARIANCE  MATRIX  OF  SLINA 
C  NMAXA  *  MAXIMUM  NUMBER  OF  NODES  IN  SLINE 

C  WILL  BE  REPLACED  BT  ACTUAL  NUMBER  COMPUTED 

C  NBAD  •  ERROR  INDICATOR 

C 

DIMENSION  PARC10l*VPAR<10»10i»SQLIN(6>»TPIN(10)*XPPf 10)>UPP(10)» 

A  UPTP ( 10) *  DPINC10) *  SL INAC  6* 100 ) » VSL INAC  6*6* 100) 

C 

DIMENSION  X(3*1)*FXC3)*FPC10)*FXPC3»10)*FXXC3*3)*FPP(10*10) 

C 

DIMENSION  UTC2)*XPC2»10)*UTPC2*10)*UPC2»10)*SOLMATC6*10) 

A*  U(2) »UTT C2)*SLINEC6*5l)*VSLINEC6*6*51) 

C  SLINE  AND  VSLINE  ARE  WORKING  AREAS  WITH  LENGTH  NMAX 
DATA  (NMAX* 51 I 
C 

NBAO-O 

DO  9  KA-1*6 

SLINECKA»1)-S0LINCKA) 

9  SLINACKA*1) -SOL  IN CK A) 

IFCNMAXA.GT.2)GOTO  12 

NBAO-U  $  PRINT  11*  NBAD  S  RETURN 

11  FORMAT ( 1H0* 10X* 30HRETURN  FROM  STRLIN  WITH  NBAD  -*I4) 

12  IFCDT.GT.O.)  GOTO  15 
IF(SLINA(1»1).GE.TMAX)  GOTO  15 
NBAD-12  S  PRINT  11*NBAD  S  RETURN 

C  DT  IS  PERMITTED  TO  BE  ZERO  FOR  ONE  POINT  STREAMLINE 
15  IF(SOLINC3).GT.O.)  GOTO  25 
C  CHECK  FOR  NEGATIVE  INITIAL  DISTANCE 
NBAD-15  $  PRINT  11*  NBAD  $  RETURN 
25  CONTINUE 

R0Z-S0LINC5)  %  GEXP-1. /AIRGAM  %  PRZ-SOL INI 2 » *AIRPR 
DO  31  1-1*2 

DO  30  KA«1»NPAR  S  XPC I»KAI-XPP <KA>  $  UP(I*KA)-UPP(KA) 


«  TIME  AT  END  POINT  OF  STREAMLINE.  THE  ACTUAL  TINE 
CAN  BE  BY  DT  LARGER  THAN  TNAX 
«  AMBIENT  PRESSURE 

*  RATIO  OF  SPECIFIC  HEATS 

-  PRESSURE  FIELD  SUBROUTINE 

*  PARAMETERS*  THEIR  VARIANCE  AND  NUMBER  FOR  PFIELD 

>  INITIAL  VALUES  ON  STREAMLINE*  VIZ. 

TINE*  PRESSURE*  DISTANCE*  VELOCITY*  DENSITY* 
DYNAMIC  PRESSURE  (-  KINETIC  ENERGY  DENSITY) 

«  D/OPAR  OF  THE  INITIAL  TINE 
«  O/DPAR  OF  INITIAL  POSITION 

>  D/DPAR  OF  INITIAL  PARTICLE  VELOCITY 

«  O/DPAR  OF  INITI ALL  PARTICLE  ACCELERATION 
«  D/DPAR  EXPRESSION  NEEEDED  FOR  INTEGRATION  OF  UPP 

*  TIME  INTERVAL  FOR  INTEGRATION 
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55 


30  UTP(I»KAI«UPTP(KAI 

31  CONTINUE 
C 

X(1»1)«SIINE(1»1)  t  X  (  2.1 )"0«  $  X(3»l)" SLINE (3*1) 

C  TINE  PRESSURE  DISTANCE 

CALL  PFIELD(X#1»PAR»F#FX* FP» FXX#FXP»FPP> LB AD) 

3500  IF(LBAD.EQ.O)  GOTO  39 

NBA0«3S00»LBA0  $  PRINT  11*  NBAD  S  RETURN 
C 

39  UT(1)»FX(3)*(PRZ/(F*AIRPRI)*«GEXP/R0Z 
C  OU/OT«-( OP/OR ) PCPQ/P )*•< 1/GANN A)/ RHOZERO 
Util*  SLINE  (4*1) 

UTTm>UT('  )*<~GEXP*(FX(l)»Um*FX(3>)/(F4AIRPR) 

A  MFXXd, 3)*U(1)*FXX( 3, 31 »/FX(3J  ) 

OTSTOR-OT  S  TST0R-SLINA(1#1)+DTST0R  *  KT-1 
C  CONFUTATION  RESULTS  HILL  BE  STOREO  APROXINATELY  FOR  TSTOR 
C  KT  COUNTS  STORAGE  IN  SLINA  AND  VSLINA 

C  THIS  IS  ACTUAL  INTEGRATION  INTERVAL.  WITH  DTS»0  GET  FIRST  NODE 
DTS-O. 

KA«1 

C 

C  NEXT  STATENENT  IS  BEGINNING  OF  INTEGRATION  LOOP 

45  SLINE  (3»KAd)«SLINE(3»KAt*DTS*(Ud)40.5*0TS*(UTd)40TS*UTTd>/3.) 
C  NEW  DISTANCE  BY  FOURTH  ORDER  FORNULA  IN  DTS 
SLINE(1*KA+1)"SLINE(1»KA) +DTS 
C  NEW  TINE 

DO  47  KB-1«NPAR 

47  XP(2,KB)«XP(l»KB)40TS*(UPd»KB)40.5*DTS*UTP(l,KBn 
C  NEW  OXSDPARANETER.  THIRD  ORDER  ERROR  IN  DTS 
C 

XClt 1»-SLINE(1,KA41)  t  X(2»l>-0  S  X(3»l)aSLINE(3»KA+l) 

CALL  PFIELOf X»l» PARvFrFX* FP»FXX»FXP»FPP»LBAD) 

IF(LBAD.EQ.O)  GOTO  55 

5100  NBAD«5100*LBAD  $  PRINT  11,  NBAD  i  RETURN 
C 

55  SLINE(2,KA*1)-F 
C  NEW  PRESSURE 

UT (2 1 «—FX<  3 |4(PRZM  F4AIRPRJ l**GEXP/ROZ 
U(2) >U(1) ♦0.5*DTS*(UT  T 1 1 ♦ UT  <211 

C  FIRST  APPROX INATIQN  OF  NEW  VELOCITY.  THIRD  ORDER  ERROR  IN  DTS 
UTTI 2 l«UT ( 2 6EXP4( FX< l|4U(2l*FX(3ll/(F*AIRPRI 
A  MFXXd,3)*U(2)*FXX(3,3))/FX(3l) 

U (21 *U(  21  ♦  (UTTd  )-UTT (2))*DTS4*2/12. 

C  NEW  VELOCITY.  FIFTH  ORDER  ERROR  IN  DTS 
SLINE ( 4»KA4ll «U( 2 1 
DO  65  KB*1»NPAR 
UTP(2»KBI«UT(2>* (-DPI N (KB ) 

A  -(FP(KB)*FX(3)*XP(2»KBU*GEXPS(F4AIRPR> 

B  ♦(FXP(  3*  KB )  ♦FXX  ( 3, 3) *XP(  2»KB )  l/FXdll 
UP(2,KBI-UP(l,KB»>0.5*DTS*(UTPd,KB»+UTP(2,KB)  > 

65  CONTINUE 

C  NEW  OU/OPARANETER.  THIRD  ORDER  ERROR  IN  DTS 
SLINE (5»KA«1)-R0Z*((F4AIRPR)/PRZ)**GEXP 
C  NEW  DENSITY 

SLINE(6,KA41)>0.5*SLINE(5,KA+l)*SLINE(4,KA4l)**2 
C  NEW  OYNANIC  PRESSURE 
C 


C  NEXT  COMPUTE  VARIANCE  ESTIMATES  OF  SOLUTION 
DO  75  KB-1#NPAR 
SOLM AT C1»KB)-TPINCKB) 

SOLM AT (2»KB)«FPCKB)*FX(3)*XP(2»KB) 

SOLNAT(3»KB)-XP(2>KB) 

SQLMAT(4»  KB)-UP(2»KB) 

SOLM AT ( 5»KBI-SLINE(5»KA*1)*(DPIN(KB) 

A  +  GE  XPMFP  (K8)+FX(3)*  XP(2»KB)  +  FXI1)  PSOLNATt 1*  KB ) ) /( F+AIRPR) ) 
SOLM AT (6»  KBI-0.59SLIN  E( A.KA+1 ) *(SLINE 1 5»KA*1)9S0LNAT C4»KB )*2 
A  ♦SLINE(4»KA*1)*S0LMATI5*KB) ) 

75  CONTINUE 

C  SOLMAT  IS  THE  JACOBIAN  MATRIX  DSL INE/DPARAKETER 
DO  95  KB-1,6  t  00  95  KC«1»6 
VSLINE(KB»KC»KA+1)«0. 

DO  85  KO-l»NPAR  t  DO  85  KE-1»NPAR 
VSLINE(KB»KC*KA«l)«VSLINE(KB»KC»KA*m 
A  SOLMAT(KB»KD )*VPAR(KD»KE )*SOLMAT(KC»KE) 

85  CONTINUE 
95  CONTINUE 
C 

C  NOW  STORE  RESULTS  IF  TSTOR  REACHED 
KA-K A+l 

IFCKT.EQ.DGOTO  97 

IFISLINEt 1»KA).LT. TSTQR-DTS+O. 2) GOTO  125 

97  DO  99  KB-lf  6  $  00  98  KC«1»6 

98  VSLINA(KB,KC»KT)-VSLINEIKB,KC#KA) 

99  SLINA(KB,KT)-SLINE<KB»KA) 

C 

IFtSLINAf 1,KT).GE.TMAX)G0T0  155 
C  BRANCH  TO  155  WHEN  ENO  OF  STREAMLINE  REACHED 
TSTOR-SLINAU»KTI*DTSTOR 

C  TIME  VALUE  FOR  NEXT  NOOE  TO  BE  STOREO  IN  SLINA 
KT-KTPl  S  0TS-0TP0.2 

C  AFTER  FIRST  NOOE  CONTINUE  WITH  DTS.GT.O. 

C 

IFIKT.LT.NMAXAIGOTO  115 
C 

C  THIS  IS  PROGRAMMING  ERROR.  WITH  GIVEN  DT  ENO  TINE  CANNOT 
C  BE  REACHED  IN  NMAXA  STEPS.  CORRECT  BY  INCREASING  DT 
OTSTOR«OTSTOR*2. 

C  ELIMINATE  HALF  OF  STORED  RESULTS 
KC-2  S  KB-3 

102  DO  10 A  KD*1»6  $  00  103  KE-1#6 

103  VSLINAIKD»KE»KC)-VSLINA(KD»KE»KB> 

10*  SLIN A(KD>KC )*SLINA(KD»KB) 

KC-KC*1  $  KB-KB+2 
I FIKB.LE. NMAXA) GOTO  102 
KT-KC-1  $  TSTOR-SLINA (1»KT) ♦DTSTOR 
GOTO  125 
C 

115  IF(KT.LE.2)KA«1 
C 

125  IFtKA.LT. NNAX1G0T0  1*5 
C 

C  NOV  VORK  AREA  IS  OVERFLOWING.  ELIMINATE  OLD  STUFF 
KC-2  $  KB-3 


132  VSlINECKE#KD,KCJ*VStINECKE*KO#KBI 

133  SLINECKD,KC1*SLINECKD»KB) 

KC-KOl  $  K8-KB*2 

175  IFUB.IE.NMAXIGOTO  131 

KA«KC-1  *  IF(KB.E0.NNAX*1)  6QT0  45 
C 

C  PREPARE  FOR  NEXT  INTEGRATION  STEP 

145  U<ll-U<2>  $  UT(l)*UT(2t  $  UTT( 1) -UTT(2) 

1BO  00  148  KB* 1#NPAR  $  XP ( 1,KB I *XP (2» K8 I  $  UP(1»KBI*UP(2»KBI 

148  UTP(l»KBI*UTP(2»KB> 

GOTO  45 
C 

155  NNAXA*KT 

185  RETURN 

ENO 
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SUBROUTINE  FI INTE R I T» R.HI ST » VH IST.NHIST. STROLD. VSTROLO. 
A  NOLD.STRNEW.VSTRNEW. NNEW. DR SIGN. NBAD) 

FLOW  FIELD  INTERPOLATION  BETWEEN  TWO  STREAMLINES. 
INTERPOLATED  RESULTS  ARE  STORED  IN  HIST  AND  VHIST. 


HI  ST ( 5* 100) 

VH 1ST (5.5. 100 ) 
NHIST 

STROLD! 6> 100 ) 
VSTR0LD(6>6> 100) 
NOLO 

STRNEW! 6*100) 

VS  TRNEWt  6. 6. 100) 

NNEW 

ORSIGN 


»  TINE  VALUE  FOR  INTERPOLATION 
«  DISTANCE  VALUE  FOR  INTERPOLATION 

■  HISTORY  VARIABLES  *  T»P.U»RH0»U4*2*RH0/2 

-  VARIANCE-COVARIANCE  MATRIX  OF  HIST 
*  NODE  NUMBER  WHERE  TO  STORE  RESULTS 

-  PREVIOUS  STREAMLINE-T.P.R.U.RHO. U**2*RH0/2 

-  VARIANCE-COVARIANCE  MATRIX  OF  STROLD 

■  NUMBER  OF  NODES  IN  STROLD 

»  NEW  STREAHLINE-T.P.R.U. RH0»U**2*RH0/2 

-  VARIANCE-COVARIANCE  MATRIX  OF  STRNEW 

-  NUMBER  OF  NODES  IN  STRNEW 

-  SIGN  OF  NEXT  DELTA-R  TO  BE  SUBTRACTED 
FROM  PREVIOUS  INITIAL  POINT  OF  STREAMLINE 

«  ERROR  INDICATOR.  NBAD-99  MEANS  THAT 
EXTRAPOLATION  WOULD  BE  NECESSARY. 


DIMENSION  HISTI5. 100) .VHISTI5, 5»100 ). STROLD (6. 100), VSTROLDI 6, 6, 
A), STRNEW! 6, 100), VSTRNEWI 6# 6, 100) 

DIMENSION  XA(6).VXA(6»6).XB(6).VXBI6. 6).XZ(6)»VXZ(6.6) 

NBAO-O 

IFI  NHIST. GE. 2) GOTO  15 
NBAD-14  $  PRINT  14, NBAD  $  RETURN 

14  FORM ATI 1H0, 10X, 31HRETURN  FROM  FLINTER  WITH  NBAD  -.14) 

NO  INTERPOLATION  FOR  FIRST  NODE  OF  HIST 

15  IFINOLD.GT . 1 ) GOTO  17 

NBAO-15  S  PRINT  14.NBA0  S  RETURN 
17  IFINNEW.GT.DGOTO  25 

NB AO* 17  i  PRINT  14.NBAD  S  RETURN 

NOW  FINO  BASE  WITH  TIME-T  ON  OLD  STREAMLINE 
25  DO  29  KA-l.NOLD 

IFIT— STR0LDI1.KA) )35» 38.29 
29  CONTINUE 

NBAD -29  S  PRINT  14.NBA0  $  RETURN 
35  IFIKA.GT.DGOTO  45 

NBAD- 35  %  PRINT  14. NBAD  $  RETURN 
38  KA1-KA  $  KA2-2 

FA1-1.  $  FA2-0.  S  GOTO  51 
45  KA1-KA-1  S  KA2-KA 

DEN- STROLD ( 1, KA2 )-STROLO( 1,  KA1 ) 

F  Al- I STROLD ll.KAZ)— T) /DEN 
FA2-IT— STR0LDI1»KA1))/0EN 
51  DO  55  KA-1.6  S  DO  53  KB-1,6 

53  VXAIKB,KA)-FA14VSTROLO(KB,KA,KA1)*FA2*VSTROLDIKB,KA,KA2I 
55  XA(KA)«FA1*STR0L0(KA.KA1)*FAZ*STR0LD(KA.KA2) 

NOW  FIND  BASE  WITH  TIME-T  ON  NEW  STREAMLINE 
00  69  KA-l.NNEW 
IFIT-STRNEWll.KA) )75»78»69 
69  CONTINUE 

NBAO-69  $  PRINT  14. NBAD  $  RETURN 
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75  IF CK A .GT. 1 1 60T0  65 

NBA0*75  $  PRINT  14» NB AD  $  RETURN 
78  KB1-KA  $  KB2«2 

FBI* 1.  $  FB2»0.  *  GOTO  91 
85  KB1-KA-1  $  KB2-KA 

DEN*STRNE  W( 1»KB2 )— STRNEWC 1»  KB1 ) 

F81«CSTRNEWI1»K82)“TI /DEN 
FB2* ( T-STRNEW<1#KB1I ) /DEN 
91  00  95  KA* 1#6  $  00  93  KB»1»6 

93  VXB(  KB»KA>  «FB1*VSTRNE WCKB»KA»KB1I^FB2*VSTRNEW( KB»KA#KB2  I 
95  XBIKA)»FB1*STRNEW<KA#KB1)*FB2*STRNEWCKA,KB2> 

C 

C  NOW  CHECK  IF  EXTRAPOLATION  REQUIRED 

IF((XA(3>-R>*(XBm-RI.LE.O.)GOTO  105 
DRSIGN-1.  S  IFCXA(3)-R.LT.0.»0RSIGN— 1. 

99  NBAD-99 

C  THIS  INDICATES  THAT  THE  NEW  VALUE  IS  OBTAINED  BY  EXTRAPOLATION 
C 

IF (X A ( 3 )— XB(3 )*NE*0«) GOTO  105 

102  NBAD-102  $  PRINT  14»NBAD  $  RETURN 
C  NOW  INTERPOLATE 

105  FA«(R— XBC3I )/CXA<3l— XBC3I I 
FB*(XA(3)-R)/CXA(3I— XB(3) ) 

DO  115  KA-1»6  *  00  114  KB>1*6 

114  VXZI KB»  KA )*FA*VXA(KB» KAI*FB*VXB(KB# KAI 

115  XZ(KA)«FA*XA(KA)*FB«XB(KA) 

C 

C  NEXT  STORE  RESULTS  IN  HIST  AND  VHIST 
00  125  KA*1*5  $  00  124  KB*1»5 
KC-KA  $  IF(KA«GT«2)KC*KA*1 
KO-KB  S  IF (KB.GT.2)KD»KB*1 

124  VHISr(KA>KB»NHISn*VXZIKC#KD) 

125  HIST ( KA»NHIST)*XZ(KC ) 

RETURN 
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SUBROUTINE  PF IEL0( X»KK,P AR, Ft F X,FP, FXX, FXP, FPP, NBAO I 


THIS  IS  PRESSURE  FIELD  CONSTRAINT  SUBROUTINE. 

THE  FUNCTION  F  IS  DEFINED  AS 

F  »CPSHOCK—C  IK*EXPCQCT  »  R»  P  ( 1 ) »  •  •  PC  4)  )  +  C ( R>  PC  5 )  I  -  P 
THE  OBSERVABLES  ARE 

TINE  T»XC  i ) »  OVERPRESSURE  P«XC2I»  RADIUS  R-XC3I 
THE  FUNCTIONS  0*PSH0CK,C  MILL  BE  OBTAINED  BY  CALLING 
QFUNCT  AND  CCOEF. 

OINENSION  X(3»ll*PAR(10>»FX(3)#FP(10)»FXX(3f3)»FXP(3»I0)#FPPC10»: 
1) 

OINENSION  QXC3)*QPC10)*QXXC3>3 I.QXP  C3.10I.QPPC 10»10)»CX(3)» 
ACPC10I»CXXC3»3I#CXPC3»10)*CPPC10#10I,PSPC10I»PSRPC10)»PSPPC10*10: 
OINENSION  PSCXC3 )»  PSC  PI 10 ) 

C 

NPSHK-4  $  GOTO  10 
ENTRY  PFIELOC 
NPSHK-0 
10  CONTINUE 
C 

C  ENTRY  PFIELOC  IS  USED  AS  CONSTRAINT  FOR  PRESSURE  FIELD  AOJUSTNENT 
C  IT  DOES  NOT  COMPUTE  DERIVATIVES  WITH  RESPECT  TO  THE  SHOCK 
C  PARAMETERS  P AR (6)  THROUGH  PARC 91 
C 

C  ENTRY  PFIELO  IS  USED  TO  COMPUTE  THE  PRESSURE  FIELD  AFTER  ADJUSTMENT 
C  IT  COMPUTES  DERIVATIVES  OF  THE  OVERPRESSURE  WITH  RESPECT  TO 
C  ALL  PARAMETERS 
C 

DO  12  KB*1» 10 

FXPC 1»KB) *0  S  FXPC2*KBI»0  t  FXPC3,KB>«0  *  FPCKBI-0 
DO  12  KC*1»10 

12  FPPC  KC  »  KB ) *0 
NBAD-0 

CALL  QFUNCT (X»KK»PAR»Q»QX»QP»QXX»QXP»QPP» 

APS»PSR»  PS  P»  PSRR»  PSRPf  PSPP»NPSHK»NBADI 
IF(NBAO.NE.O) RETURN 

CALL  CCOEFC  X» KK*  PAR»C »CX»CP; C XX»C XP.CPP »NBAO) 

I F(NBAO.NE.O) RETURN 
C 

PSC»PS-C 

13  IFCQ.LT.740.)  GOTO  19  S  NBAD-740  $  RETURN 

14  EXPQ*0.  $  IFCQ.GT.-670. I  EXPQ-EXPCQt 

C  STATEMENTS  13  AND  14  AVOID  OVERFLOW  OR  UNDERFLOW  BY  EXP  FUNCTION 
FEX»PSC*E  XPQ 
F»FEX+C-XC2,KK» 

DO  19  KB-1»3 
PSCXCKBI— CXCKB) 

15  FXCKBI*EXPQ*CPSC*OXCKB)»PSCXCKB))*CXCKB) 

FXC2 1 *FXC  2 1—1. 

PSCXC3)-PSCXC3)*PSR 

FXC3I-FXC  3I+EXPQ4PSR 
DO  25  K  B*  1  *  5 
PSCPCKB)—  CPCKBI 

25  FPCKBI*  EX  PQ*t  PSC*QP  CKB)*P  SC  PCKBM  ♦CPCKBI 

C 


FXP(KB»KC) * EXPO* (P SC* (QXP (KB»  KC )*QX(KBl *QP( KC 1 1 
A«-QX{KB>*PSCP(KC)*PSCX<KB)*QP(KC)-CXP(KB»KC))*CXP(KB*KC) 

35  CONTINUE 
C 

DO  32  KB*1»  3  $  DO  32  KC*1»3 

F  XX(  KB>  KC ) *EXPQ*( PSC*(QXX(KB»KC)+QX(KB)*QX(KC) l 
A*QX(KBJ*PSCX<KC>*PSCX<KB>*QX(KC>-CXX(KBfKC> >*CXX<KBfKC) 

32  CONTINUE 

FXX<3»3)«FXX(3»3)*EXPQ*PSRR 

C 

DO  45  KB*  1»  5  $  DO  45  KC«1»5 

FPPI  KB#  KC ) *EXPO*l PSC* ( OPP (KB»  KC )*OP(KB )*OP(KC ) ) 
A*QP(KB)*PSCP<KC)+PSCP<KB>*QP(KC)-CPP(KB»KC) )*CPP(KB»KC> 

45  CONTINUE 
C 

IF<NPSHK<LE<0I60T0  75 

C  NPSHK  IS  THE  NUMBER  OF  SHOCK  PARAHETERS<  NPSHK-0  OR  *4 
KUP*  5*4 

C  ASSUME  THAT  PRESSURE  FUNCTION  HAS  5  PARAMETERS  ANO  SHOCK  HAS  4  PAR 
DO  55  K8*6»KUP 
PSCP<KB»*PSP<KB» 

FP(K8)*EXP0*I  PSC*OP  (KB )  ♦•PSCPIKB)) 

DO  52  KC* 1»  3 

FXP(KCfKBI*EXPQ*(PSC*(QXP(KC»KB)*<1X(KCI  *0P(  KB  I  > 
A*QX(KC)*PSCP(KB)*PSCX(KC)+(JP(KB)) 

52  CONTINUE 

FXP<  3»K8)  *F  XP  <3»KB)*E  XPO*PSRP( KB> 

DO  55  KC*6»  KUP 

FPP( KBt  KC I *EXPQ*(PSC* (QPP(KB*KC I*QP  (KB) *QP(KC I ) 
A+QP(KB)*PSCP(KC)+PSCP(KB)*QP(KC)*PSPP(KB»KCn 
55  CONTINUE 

DO  65  KB* 5  S  DO  65  KC*6,KUP 
FPP(KBfKC) «EXPQ* ( PSC*(QPP (KB»KCI *QP (KB)*QP(  KC 1 1 
A*QP<KBI*PSCP<KCI*PSCP<KB>*OP<KC)*PSPr<KB#KCII 
65  FPPI  KC*KB>  *FPP(KB#KCI 

75  CONTINUE 
RETURN 
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SUBROUTINE  QFUNCT < X»KK» PAR, Q» QX»QP,QXX» OXP* QPP» 

APS»PSR» PS  P«  PSRR# PSR P, PSPP*NPSHK,NBAD> 

AUXILIARY  ROUTINE  FOR  PFIELO.  IT  CONFUTES  THE  EXPONENT  9  OF  THE 
PRESSURE  FIELD  FUNCTION.  IT  ALSO  TRANSNITS  THE  SHOCK 
OVERPRESSURE  PSCR)  WITH  DERIVATIVES. 

SUBROUTINES  ACOEF#BCOEF  AND  SHOOER  ARE  NEEDED 

OINENSION  X(3»lt»PAR(10)»0Xm»QPU0>»QXX(3»3)»QXP(3»10l* 

A  QPP <i0»10)>AXm»APtl0),AXX(3»3)»AXP(3»10t»APPf  10*101 , 

B  TAUXI3) 

OINENSION  TP(10)»TRP(10)« TPP(10»10)»PSP(101»PSRPf 10)»PSPP(10«10) 

C 

CONNON/CSC  ALE/SCDIS»SCPRE»SCTIN 

CONNON/CONSHK/NPSH  >PARSH(4)» VPARSHI4#4I»SCDSH*SCPSH*SCTSH 
C 

00  12  KA«1»10  $  QP(KA>-0  $  DO  10  KB*1»3 
10  0XP(KB»KA)>0  $  DO  12  KC«1»10 
12  QPPI KA»KC 1*0 

NBAD-0  $  R*X( 3»KK)*SCDIS 
C 

IFINPSHK. GT.O)  GOTO  13 

C  IF  NPSHK  »  NUNBER  OF  SHOCK  PARANETERS  IS  ZERO  THEN  CONFUTE  ONLY 
C  DERIVATIVES  WITH  RESPECT  TO  PRESSURE  PARANETERS  PARIl)  THROUGH  PARC 
CALL  SH0CK2(R#T#TR#TRRf PS#PSR»PSRR# NBAOI 
IF(NB AD.NE . 0)  RETURN 
GOTO  14 
C 

13  CONTINUE 

CALL  SHODE  RIR»T»  TR»TP*TRR*TRP* TPP#PS*PSR*PSP# 

A  PSR R» PSR  P*  PSPP#  NB  ADI 
I F (N B AD.NE. 0) RETURN 
C 

14  CONTINUE 

C  SH0CK2  OR  SHOOER  CONFUTED  EVRYTHING  IN  SI  UNITS.  NOW  SCALE  RESULTS 
C  ACCORDING  TO  THE  SCALES  IN  SCSCALE/ 

T-T/SCTIN  %  TR-TR4SCDIS/SCTIN  i  TRR>TRR*SCDIS**2/SCTIN 
PS-PS/SCPRE  $  PSR»PSR*SCDI S/SCPRE  B  PSRR»PSRR*SCDIS**2/SCPRE 
IF(NPSHK.LE.O)  GOTO  16 
C 

DO  IS  KB*6»8 

TPIKB  >*TP IKB l*SCPRE*SCDISP*l KB-51 /SC TIN 
PSP(KB)«PSP(KB>*SCDIS**(KB~5» 
TRP(KB>-TRP(KB)*SCDIS**<KB-4)*SCPRE/SCTIN 
PSRP(KBI«PSRP (KB )*SCD IS**IKB-4 ) 

TPP(9»KB)»TPP(9»KB)*SCPRE*SCDISM|KB-5>  *  TPPIKB»9)«TPP(9,KBI 
PSPP(9»K8>-PSPP<9»KB>*SCTIN*SCDIS**IKB-5>  S  PSPPCKBt 9»«PSPP»9,KB 
DO  15  KC*6»8 

TPPIKC»KB)-TPP«KC»KB»*ISCPRE/SCTINI*424SC0IS**CKB*KC-10» 

PSPP(KC»T3!«PSPP(KC»KBI4SCDIS**(KB4KC-10) 

13  CONTINUE 

PSP(9I«PSPI9I*SCTIN/SCPRE 

TPP(9*9I»TPP(9#9|4SCTIN 

PSPP(9*9»«PSPP(9»9J*ISCTIN/SCPRE»4*2 

C 

16  CONTINUE 

T  AU»Xf 1»KK )-T 


T AUX (11*1.  $  TAUXC2I-0.  *  TAUX<3»«-TR 


C 

C  NEXT  COMPUTE  THE  LINEAR  TERN  IN  THE  EXPONENT 

CALL  ACOEF  < X»KK» PAR* A»AX» AP» AXXvAXP* APPtNBAD) 

I F(NBA0.NE*0) RETURN 
Q-APTAU 
C 

00  25  K8*l»  3 

OXCKB )»AX(KB)PTAU>A*T AUX(KB) 

00  25  KC»l#3 

QXX(KB»KCt-AXX<KB*KC>*TAU4AX(KB>*TAUX(KC)*AX(KC)*TAUXfKBt 
25  CONTINUE 

QXX(3»3I-QXX<3#3)~A*TRR 

C 

00  35  KB«1*3  *  00  35  KC«1»5 
35  QXP(KB*KC)-AXP(KB*KCI*TAU*AP(KC)*TAUX(KB> 

C 

DO  45  K8-l#5  S  QPCKBI -API  KB l«TAU 
00  45  KC*1»  5 

45  QPP(KB*KC>-APP(KB*KC>*TAU 
IF(NPSHK.LE.0)60T0  53 

C  NPSHK  IS  THE  NUMBER  OF  SHOCK  PARAMETERS 
KUP*5*NPSHK 

C  ASSUME  THAT  PRESSURE  FIELD  HAS  5  PARAMETERS 
00  48  KA»6#KUP 
OPIKAI— A«TP(KA) 

OXP( 3»KA)>-AX(3)*TP(KA)-A*TRP<KA) 

00  48  KB-6*KUP 
48  QPP(KA»KB1  —  A*TPP(KA»KB> 

00  50  KA-1#5  S  00  50  KB«6«KUP 
OPP|KA#KB»—  AP(KA>*TPIKB> 

50  OPPI  KB* KA )«QPP(KA#KBI 
C 

C  NEXT  COMPUTE  QUADRATIC  TERN 

53  CALL  BCOEFI X»KKf  PAR*  A*  AX*  AP» AXX* AXP»APP»NBAD) 

If (NB AO *NE»0) RETURN 
0-0*A*TAU*TAU 
C 

DO  55  KB-1*3 

QX(KB)*QX(KBH>TAU*(AX(KB)*TAUp2.*A*TAUX(KBI  I 
00  55  KC«l*3 

QXXIKB»KC)*QXXCKB*KC>*TAU*(AXX tKB,KC)*TAU»2.PAX(KB)PTAUX<KC> 
A+2.*AX(KC  >*TAUX(KBI)*2.*A*TAUX(KB)*TAUX(KCt 
55  CONTINUE 

QXXI 3»3I*QXXC3» 3)-2»*APTAU*TRR 
C 

00  65  K6«l»3  $  00  65  KC»l*5 

QXPCKB»KC»«0XPCKB*KCI*TAU*UXP<KB,KC>*TAU*2.P 
ATAUX(KBI*AP(KC)t 
65  CONTINUE 
C 

00  T5  KB*1» 5  S  QPIKBt ■QPIKBI*AP|KB>*TAU6TAU 
00  75  KC*1»  5 

75  QPP(KB*KC>>QPP<K6*KC>*APP(KB*KC>*TAU*TAU 
IFIMPSHK.LE.0I60T0  97 
00  85  KA«6»KUP 

QP(KAI«QPIKA1— A*2«*TAU4TPCKAI 


QXP(3»KA>aQXP(3»KA)«2.*<-AXm*TAU*TPCKA)*A*TP(KA)*TR 

A-A*TAU*TRP(KA» 

DO  89  KB«6»KUP 

QPP(KA»KB)«QPP(KA»KB)*A*2.*(TP(KA)*TP(KB)-T AU*TPP(KA»KB ) ) 
85  CONTINUE 

DO  95  KA»6#KUP  $  DO  95  KB«l>5 
QPP(KB»KA)»QPP(KB»KA)-2«*AP(KB)*TP<KAI*TAU 
95  QPP(KA»KB)>QPP(KB»KA) 

97  CONTINUE 
RETURN 


SUBROUTINE  ACOEF I X»KK*PAR* A* AX* AP*AXX» AXP* APP»NBAD) 

C  LINEAR  COEFFICIENT  IN  PRESSURE  FIELO  EXPONENT 
C  AUXILIARY  ROUTINE  FOR  QFUNCT 
C 

DIMENSION  Xt3*L)»PARtlO>»AXI3)*APtlO)*AXX( 3*3) *AXP( 3*10)* 
AAPPtl0*10>»CPI2)*CXPt2>»CPPt2»2) 

CONNON/CFLOEX/EX A»EXB*EXC 
C 

NBAO-O 

R-X(3*KKI  $  PWARIll  $  P2-PAR 12) 

EX-EXA 

CALL  COEFFI IR»P1»  P2»E  X*A*CX*CP*CXX»CXP*CPP*  NBAO) 

I  FIN BAD *E  0*0)  GOTO  15  %  NB AO-NB A0*100  S  RETURN 
C 

15  00  25  KA-1.5  %  APIKAI-0  $  IFIKA.LE.3) AXIKAI -0 
00  25  KB>1*5  %  IFIKA.LE.3IAXPI KA»KB)«0 
IFIKA.LE.3.AN0.KB.LE.3)AXXIKA»KB)«0 
25  APPI KA*KB ) *0 
C 

AXI3 1  *CX  i  APIll-CPfl)  %  API2)-CPI2> 

AXXI3»3)-CXX  S  AXPI3*1)-CXPU)  $  AXPI 3# 2) -C XP 1 2 1 
00  35  KA-1»2  i  DO  35  KB-1*2 
35  APPI K A*  KB ) "CP PIKA* KB) 

RETURN  t  END 


SUBROUTINE  BCOEF ( X*KK»PARi A» AX* AP» AXX» AXP» APPiNB AD) 
C  QUADRATIC  COEFFICIENT  IN  PRESSURE  FIELO  EXPONENT 
C  AUXILIARY  ROUTINE  FOR  QFUNCT 
C 

DIMENSION  X Oil) *PAR( 10)* AX (3) *AP(10)#AXX( 3*3)  » 
AAXP(3»10)*APP(10»10)»CP(2)*CXP(2)iCPP(2»2) 
CONNON/CFLOEX/EXAi EXBiEXC 
C 

NBAD-0 

R-XOiKK)  i  Pl-PARO)  «  P2>PAR(4) 

EX-EXB 

CALL  COEFFI (RiP1iP2iEXiAiCXiCPiCXXi CXPiCPPiNBAD) 
IFCNBAD.EQ.OUOTO  15  $  NBADa200*NBAD  B  RETURN 
C 

15  DO  25  KA«li5  $  AP(KA)-0  S  I F ( K A.LE. 21 AX(KA) *0 
DO  25  *8-1*5  «  IF ( KA. LE*3 ) AXP ( KA»KB)aO 
IFCKA.LE.3. AND.KB.LE. 3)AXX(KA* KB)aO 
25  APP(KA*KB)aO 
C 

AX(3) *CX  *  AP(3)aCP(l)  S  AP(4)-CPt2) 

AXX(  3i3)aCXX  S  AXP(3*  3)aCXP(l)  *  AXPI  3i4laCXP(2) 

DO  35  KA«li2  *  DO  35  KBali2 
35  APPI 2+KA*2+KB)aCPP(KA*KB) 

RETURN  %  ENO 


SUBROUTINE  CCOEF<X»KK»F AR»A» AX» AF»AXX» AXF»AFF#NBAO> 

C  THIS  IS  ADDITIVE  COEFFICIENT  IN  FRESSURE  FIELD  FORNULA 
C  AUXILIARY  ROUTINE  FOR  FFIELD 
C 

DIMENSION  X<3»ll»FAR<10>»AXm»Af>(10)#AXX(3»3>'AXF(3,10>» 
A  AFFI 10#10I#CFC2I»CXF I2I»CFF( 2*2 ) 

CONNON/CFLDEX/EXA, EXB»EXC 
C 

NBAO-O 

R«X(3»KK>  $  FI*FAR(SI  *  F2»0. 

EX-EXC 

CALL  COEFFt<R»FI*F2»EX»A*CK*CF*CXX*CXF»CFF*NBAD> 
IFINBAD.EQ.0I6OT0  IS  $  NBAD>NBA0*300  %  RETURN 
C 

IS  00  2S  KA-l»5  *  AFIKAI *0  %  IF(KA.LE.3» AX(KA) «0 
DO  25  NB-l*5  S  IFfKA.LE.3>AXF(KA*KB)-0 
IFIKA.LE. 3. ANO.KB.LE* 3) AXX(KA»KB)«0 
25  AFF(KA#KB)-0 
C 

AX(3)-CX  S  AFIS)-CF(l) 

AXXt 3*  3)SCXX  t  AXF(3»S)«CXF(II 

AFF(S»S)-CFF(l»lt 

RETURN  $  END 


SUBROUTINE  COEFF I < R, P 1,P2,EX, A» AX, AP, AXX, AXP, APP» NBAD » 

C  THIS  CONFUTES  TAU  COEFFICIENTS  TO  BE  USED  IN  PRESSURE  FIELD 
C  FUNCTION  EXPONENT  AND  AS  ADDITIVE  TERN.  THE  COEFFICIENTS  DEPEND  ON  l 
C 

DIMENSION  AP(2)»AXP(2)»APP(2»2) 

C 

NBAD-0 
REX-1. /R**EX 
A-REX*«P1*P2*R) 

C  A  IS  THE  COEFFICIENT.  NEXT  CONFUTE  FIRST  ORDER  DERIVATIVES 
AX>REX*(-Pl*EX/R*P2*t l.-EX) ) 

APUI-REX  «  AP  (  2)  -REX*R 
C  NEXT  CONFUTE  SECOND  OROER  DERIVATIVES 

AXX-REX*(P1*EX*(EX*1. )/R-P2*(l.-EX)*EX)/R 
AXP(  1I-REX*(-EX»/R  $  AXPC2>-REX*<1.-EX> 

APPI1.D-0.  $  APP(l»2l-0.  t  APP( 2*1  )-0.  %  APP(2,2>-0. 

RETURN  $  END 


nonnoortrtnono 


SUBROUTINE  SHOCK (R»T»POV»US  »  UP»  RHO»  NBAO ) 

THIS  COMPUTES  SHOCK  VALUES  USING  PARAMETERS  FROM  /CQMSHCK/ 

ALL  ARGUMENTS  ARE  ASSUMCO  TO  BE  EXPRESSED  IN  SI  UNITS 
ROUTINE  USES  ROMBIN  AND  SHTINT  TO  COMPUTE  SHOCK  ARRIVAL  TIME 

R  >  SHOCK  DISTANCE  (GIVEN) 

T  •  SHOCK  ARRIVAL  TIME 

POV  -  INCIDENTAL  SHOCK  OVERPRESSURE 
US  -  SHOCK  SPEED 

UP  -  PARTICLE  VELOCITY  BEHIND  SHOCK 

RHO  -  SHOCK  DENSITY 

N8A0  •  ERROR  INDICATOR.  NBAD.NE.O  IN  CASE  OF  ERROR  RETURN 

EXTERNAL  SHTINT 
C  INTEGRAND  TO  COMPUTE  SHOCK  ARRIVAL  TIME 
C 

CONMQN/COMSHK/NPS*  PARSHC4 )»  VPARSH(4»4 ) »  SCO IS*  SCPRE# SCTIM 
COMMON/ AM BC HA/P Z#TZ»  GAM. AMQL»CHVOL»CHEN» CHHyCHHER 
COMMON/CF  ZOER/GAMC AP» SNDSPD*  PAR( 4)»  ALOW*  SCD»SCP»  SCT 
C 

GANC AP*GANC AP/SCP  S  SNDSPD*SNDSPD*SCD/SCT  S  ALOW* ALOW*SCD 
SCO-1.  S  SCP-1.  t  SCT-1. 

DO  15  KA-1,3 

15  PAR(KA)«PARSH(KA)*SCPRE  *SCDIS**KA 
P  ARC  4)-PARSH(4)*SCTIM 

C  THIS  CHAN6E0  THE  CONTENTS  OF  /CF2DER/  INTO  SI  UNITS 
C 

POV-I (PAR(3)/R*PAR(2) ) /R*PAR ( 1 ) ) /R 
CALL  ROMBINI SHTINT, ALOW* R,F,NB AD) 

C  QUADRATURE  TO  COMPUTE  SHOCK  ARRIVAL  TIME 
IF(NBAO.EQ.O)  60  TO  30 
PRINT  20* NBAO 

20  FORMAT ( 1H  ,*RETURN  FROM  SHOCK  WITH  NBAO-  *»I5) 

RETURN 

C 

30  CONTINUE 

T -F/ SNDSPO  ♦PARI 4) 

US -SORT ISNDSPD**2*( 1. ♦GAMCAP+POV) ) 

RHOZ* ( AMOL/8. 3143)*(PZ/TZ) 

UP-PQV/ (RHOZ*US ) 

RHO-RHOZ*! 1 •♦GANC AP*POV)/ I 1 •♦( GAM— 1. )*P0V40.5/ I GAM4PZ I ) 

RETURN 

ENO 


SUBROUTINE  SHOCK2 ( R, T, TR» TRR, P» PR* PRR, NBAD! 

C  THIS  ROUTINE  COMPUTES  SHOCK  ARRIVAL  TINE  AND  OVERPRESSURE  FOR 
C  GIVEN  01  STANCE 
CC 

C  R  -  SHOCK  DISTANCE  (GIVENI 
C  T  «  SHOCK  ARRIVAL  TIME 

C  TR ,  TRR  •  DERIVATIVES  OF  T  WITH  RESPECT  TO  R 
CP-  SHOCK  OVERPRESSURE 

C  PR,  PRR  -  DERIVATIVES  OF  P  WITH  RESPECT  TO  R 
C 

C  ALL  QUANTITIES  ARE  CONPUTEO  IN  SI  UNITS 
C 

EXTERNAL  SHTINT 

CONMON/CONSHK/NPS, P ARS (4) , VPI 4, 4),SC0S, SCPS,SCTS 
COMNON/CF  2DER/GAMCAP, SN0SPD,CP(4)» ALOV, SCO,SCP> SCT 
C 

GAHC  AP-GANC AP/SCP  t  SNDSPD-S NDSPO*SCD/SCT  %  A10V-AL0W*SCD 
SCD-1.  S  SCP-1.  $  SCT -1  • 

DO  15  KA-1,3 

15  CP(KA>«PARSCKAt*SCPS*SCDS**KA 
CP(4)-PARS(4)*SCTS 

C  THIS  TRANSFORMED  /CF2DER/  INTO  SI  UNITS 
C 

CALL  ROMB IN ( SHTINT, ALOW, R»T, NBAD) 

C  QUADRATURE  TO  COMPUTE  SHOCK  ARRIVAL  TINE 
IF(NBAD.EQ.O)  GO  TO  30 
PRINT  20, NBAD 

20  FORMAT ( 1H  , PRETURN  FROM  SH0CK2  WITH  NBAD-  *,I5» 

30  CONTINUE 
C 

P-((CP(3)/R«CP(2)l/RPCPm)/R 

PR— (  <3.*CP(3)/R*2.*CP(2>  I / R*C P ( 1 >) /R**2 

PRR- 1  (12.  •CP(3l/RP6.PCP(2n/RPCPllll/R**3 

T«T/SNDSPD»CP(4I 

SQ-l.PGANCAPPP 

TR-1./ (SORT (SOI PSNDSPD) 

TRR— 0.5PGAHCAP4TRPPR/SQ 
RETURN 


SUBROUTINE  SHTINTIX*F»NBAD> 

C  INTEGRAND  FOR  SHOCK  ARRIVAL  TIME  CONFUTATION 

CONNON/CF2DE R/GANCAP» SNDSPD»PARf Al» ALQM»SCO»SCP»SCT 
C 

IFU.GT.l.E-10)  GOTO  15  *  NBAD*l  *  RETURN 

15  SQ-l.*6AHCAP*<<PAR<31/X*PAR<2>)/X4PARfl)l/X 

IFCSQ.GT.l. E-lOO)  GOTO  25  $  NBAO-2  t  RETURN 

F«l» /SORT! SOI  t  NBAD-0 
RETURN 
ENO 


25 


SUBROUTINE  ROMS  I N  ( F, A, B» PINT* NBAD J 
C  ROMBERG  INTEGRATION  SUBROUTINE 
C 

DIMENSION  TU0,20>,C0RKN(10> 

C 

NBAD*  0 

CALL  F<A,FA,NBAD>  $  IF (NS AD. NE . OJRETURN 
CALL  FtB,FB,N8AD)  $  IF(NBAD«NE.O)RETURN 
T  { 1, 1  )*<FA*FB)*0.5 
KM*1  $  KM A*1 
C 

15  DEN-FLOAT(KMA)*2.  S  FM*0 
DO  25  KA«1,KMA 
AC*FLOAT(  1«-2*(KMA-KAJ  l/DEN 
BC*F  LOATl 2*KA— 1 ) /DEN 
ARG-  AC*A*BC*B 

CALL  F( ARG»FN,NBAD)  t  IF ( NBAD . NE .0) RETURN 
FM*FH*FN 
25  CONTINUE 

FM-FM/FLOATCKMA) 

T<1,KN*1>«CT<  1»KM  )  ♦  FM  )  +0»  5 
C  THIS  IS  TRAPEZ.  NOW  COMPUTE  ROMBERG 
KM-KM*1  $  KC-1  t  0DEN*1. 

C 

35  KC*KC*1  S  D0EN*00EN*4. 

C0RKM(KC)*(T<KC-1,KM»-TCKC-1»KM-1»  )/< ODEN-1.) 

T ( KC , KM )* T  < KC-1, KM ) *C ORKM CKC  ) 
IF(KC.LT.KM.AND.KC.LT.10)G0T0  35 
IFIKC.GE.3IG0T0  45 

C  AFTER  AT  LEAST  3  STEPS  BRANCH  TO  45  AND  TEST  CONVERGENCE 
KMA*  KMA*2  %  GOTO  15 
C 

45  00  55  KA*2, KC 

TEST-ABS(CORKM(KA»l 

IF(TEST.LE. ABS(T(KC, KM  11*1. E-10) GOTO  65 
IF(TEST.LE.1.E-100|G0T0  65 
55  CONTINUE 

IF(KM.GE.20»G0T0  65 

C  COMPUTE  NOT  MORE  THAN  20  ROMBERG  CORRECTIONS 
KMA-KMA*2  $  GOTO  15 
C 

65  FINT-T(KC,KM»*IB-A) 

RETURN 
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SUBROUTINE  SHGOER (R » T»  TR»  TP*TRR»TRP»TPP» 

A  POV» PRfPP»PRR»PRP»PPP»NBAO> 

C  THIS  COMPUTES  FOR  GIVEN  DISTANCE  R  THE  CORRESPONDING 
C  SHOCK  TIME  T  AND  OVERPRESSURE  PQV>  AND  DERIVATIVES 
C  SUBROUTINE  USES  F2SHCK  TO  COMPUTE  SHOCK  ARRIVAL  TIME 
C  ALL  ARGUMENTS  ARE  ASSUMED  TO  BE  IN  SI  UNITS 
C 

DIMENSION  TPC10) #TRP< 10)»TPP( 10»10» ,PP(iO»»PRP(l01»PPP<10» 10»» 
A  SPAR<10>»XI5»1)fFXI5>»FPI10)»FXXI.5,5),FXPI 5, 1 0) *FPP C 10* 101 
C 

CQMMQN/CQMSHK/NPS*  PARSH(4)»VPARSH(4»4I»$CDIS»SCPRE»SCTIM 
C0MM0N/CF20ER/GAMCAP*  SNOSPQf PRS( 4 )» ALOW* SCO* SCP» SCT 
C 

GAMC AP«GAMC AP/SCP  %  SNDSPD«SNDSPO*SCD/SCT  %  ALOW«ALOW*SCD 
SCD-1.  i  SCP«1.  *  SCT-1. 

C  THIS  CHANGEO  /CF2DER/  TO  SI  UNITS 
IFINPS.GE . 0. AND. NPS.LE . 5 ) GOTO  15 
C  THIS  IS  COOED  FOR  NPS  ■  NUMBER  OF  SHOCK  PARAMETERS  »  4 
N  BAD  *  I ABS l NPS )  $  RETURN 
25  N  8  AD  *  2  5  $  RETURN 
C 

15  IFCR.LE.O. IGOTO  25 

N  8  AO  *  0 

IFINPS.EQ.01G0T0  55 
C 

C  NOW  COMPUTE  SHOCK  OVERPRESSURE  IN  PASCALS  BY  3-PARAMETER  FORMULA 
00  35  KA»1,3 

35  SPARIKA»«PARSH<KAJ*SCPRE*SCDIS**KA 

SPAR(4I«PARSH(4)*SCTIM 

C  SPAR  IS  FOR  COMPUTATION  OF  POV  IN  PASCALS  WHEN  R  IS  IN  METRES 
C 

POV-( (SPAR(3WR*SPAR( 2) ) /R+SPARI 1 I ) / R 
PR  — <  <SPAR<3>*3./R*SPAR12)*Z. I /R*SPARfl) > SR**2 
PRR«<  <SPAR<3»*12./R*$PAR(2>*6.>/R*SPAR(l)*2.)/'-**3 
C 

00  37  KA«1,10  $  PPIKA»"0  %  PRPIKAI-0 
TP(KA!«0  $  TRP(KAI»0 
00  37  K8-l»10  $  TPPIKA»KB)"0 
37  PPP( K A»  KB ) «0 
C 

C  ASSUME  THAT  SHOCK  PARAMETERS  ARE  NR.  6,7»6*9. 

PPC6I-1./R  $  PP I  71 «PP ( 6)/R  S  PP18)«PPI7)/R 
PRP<6>— PPI7J  S  PRPI7»«-2.*PP(8>  %  PRP<  8)  — 3.  *PP  (8)  7R 
C  NEXT  COMPUTE  SHOCK  ARRIVAL  TIME.  X<1)«PRESSUREf  XC3I-TIME 
X(l.l»«0  *  X<2»ll"R  S  X(3,l)*0 
CALL  F2SHCK(X»1»SPAR»F»FX»FP»FXX»FXP»FPP»NBADI 
C 

IFINBAD.NE. 0) GOTO  55 

T-F/SNOSPD  $  TR«FX( 2)/SNDSPD  %  TRR«FXXC2>Z)/SNDSPD 
C 

DO  45  KA« 1» NPS  S  TPt  5 +K  A) -FP<  K  A  WSNDSPD 

TRP(5*KA>«FXP(2»KAI/SNDSP0 

DO  45  KBMfNPS 

45  TPP<  5*KA» 5*KBI«FPP(KA»KBI /SNDSPO 
C 

55  CONTINUE 
RETURN 
END 


219 


SUBROUTINE  F2SHCK ( XX, K A.P AR, F»  FX» FP» FXX, FXP, FPP. N8A0 ) 

C  THIS  IS  SECOND  CONSTRAINT  COMPONENT  FOR  SHOCK  FITTIN6 
C 

DIMENSION  XXI5»100)»PARI10)»FX(5l»FPIl(M»FXX(5»5)»FXPI5fl0)» 
A  F  PP 1 10.10 1 »  SFI9 ) 

C 

EXTERNAL  F2DER 
C 

COMMON/CF2DER76AMCAP, SNOSPD, CP ARI4I, ALOW. SCO. SCP.SCT 
C  GAMCAP-C Il.+  GAMt/t2.*GANn*tSCPR/ANBPR) 

C  GAMCAP.  SNOSPD  AND  ALOW  ARE  SET  BY  SUBROUTINE  SCALSH 
C 

00  15  KB-1,4 
15  CPARtKB)«PARIKBt 

C  THE  PARAMETERS  CPAR  WILL  BE  USED  BY  SUBROUTINE  F20ER 
X«XXI 2.KA) 

DO  25  KB-1,3  $  00  25  KC-1,3 
25  FXXI KB.KC ) *0 

I  F I X . GT . 1 . E-30)  GOTO  35  %  NBAO-1  $  RETURN 
C 

35  NBAD-0 

SQ*1 • PGAMC AP*( ( PAR ( 3) /X*PAR 1 2 » ) /X+PAR C 1 > > /X 
IFISQ.6T. l.E-50  I  GOTO  45  $  NBAO-2  *  RETURN 
45  FX(1)«0.  t  FX(2)-1./SQRT(SQ)  %  FXI3)— SNOSPD 

FXXI 2. 2 1»0. 5*GAMC APPF X (2 1 *1 I  3. *PARI 31 7X>2.*PAR I  2 1 )/X 
A  ♦  PARU))/tX*X*SQ> 

C  COMPUTE  PARTS  OF  F2  ANO  DERIVATIVES  BY  MULTIPLE  QUADRATURE 
CALL  R0MULTIF20ER. ALOW.X. SF.NBAD) 

IF(NBAD.EQ.O)  GOTO  55  $  NBAD-NBAD+10  *  RETURN 
55  F*SF  Il)*tPARI4)— XXI3, KAI  I *SNDS  PD 

FPI1)-SFI2)  *  FPI2I-SFI3)  $  FP(3»-SF(4»  t  FPI41-SN0SPD 

FPPI 1.1)*SF  C5I  t  FPP( 1.2) *SF (6  )  %  FPP II, 31 -SF < 71 
FPPI2.1J-SF 16)  $  FPPI  2»2I«SFI 7)  $  FPPI 2, 3) >SF 1 8 ) 
FPPI3.1I-SFI71  %  FPPI 3.2I-SFI8)  $  FPPI3.3I-SFI9) 

00  65  KB-1.4  t  FPPI4.KBI-0  $  FPPIKB.41-0  S  FXPIl.KBI-0 
65  FXPI3.KBI-0 

FXPI  2,1>  —  0.5*GAMCAP*FXI2>/ IX^SQ) 

F  XPI 2»2)«FXP(2»1)/X  %  FXPI2»3)»FXPI2.2)/X  S  FXPI2.4I-0 
RETURN 


SUBROUTINE  F20ER  <  X*  f .  fiBAO  I 

C  INTEGRAND  FOR  NINE  COMPONENTS  OF  F2  AND  DERIVATIVES 
C  USED  BY  F2SHCK  AS  ARGUMENT  OF  ROHULT 
C 

DIMENSION  F(9) 

C 

COMMON/CF2DER/GAMC AP» SNDSPD,  P AR ( 4) , ALOV, SCD» SCP» SC T 
C  GAMC  AP* ( (1,+GAM)/(2»*GAM) ) * { SC  P  / AMBPR I 

C  GAMCAP,  SNDSPD,  ALOW  AND  SCALES  ARE  SET  BY  SUBROUTINE  SCALSH 
C 

N  B  AD  *  0  $  IFIX.GT.l.E-30)  GOTO  15  $  NBAD-1  t  RETURN 
C 

15  Y-l./X 

SQ»1.  ♦GAMCAPM  (PARI  31  *Y*PAR  <2  I  >*Y*PAR<1  DRY 
I F ( S  Q . GT. 1 . E-50  1  GOTO  25  $  NB AD«2  $  RETURN 
C 

C  INTEGRANDS  CORRESPOND  TO  FOLLOWING  QUANTITIES  . 

C  F.PPIll, (21* (3>,FPP<1,1>, (1,2), (1, 31- (2,2), (2, 31,13, 3) 

25  F  (  II  *  1. /SQRT (SOI 

F  <  21 »-0.5*GAMCAP*FCl)*Y/SQ 
F(3I «F(2I*Y  $  F ( 4  I »F( 3>*Y 
F(5I«-1.5*GAMCAP*F(3I/SQ 

F  (  61  *F<  51  *Y  S  F  <  7 1 «F( 6  I* Y  S  F(8I««F(7I*Y  t  F(9I«F(8I*Y 

RETURN 

ENO 


SUBROUTINE  ROMULT IFfAfBfSFfNBAD) 

ROMBERG  INTEGRATION  OF  A  9-DIMENSIONAL  VECTOR  FUNCTION 

DIMENSION  S F 191 ,  Tl 9, 10, 201, F AI 91, FBI9 1 , FN 19 1, FMI 91 , CORKNl 9, 101 

NBAD-0 

CALL  F( Af FAf NBAOI  $  IFCNBAO.NE .0)  RETURN 
CALL  FI Bf FB»NBAD)  t  IF(NBAD.NE.O)  RETURN 
DO  14  KD*If 9 

14  TIKD,1,1I»IFAIKD)*FBIKD)I*0.5 
KH-1  $  KNA*1 

19  00  16  K0-l,9 
16  FNIKO I *0 

DENa FLOAT! KMA 1*2. 

DO  25  KA-lfKHA 

AC-FLOATI 1*2*IKMA-KAI l/OEN  S  BCaFL0AT!2*KA-ll/DEN 
ARGa AC*A*BC*B 

CALL  F I ARGfFNf NBAOI  S  IFINBAD.NE.OI  RETURN 
DO  23  KD*1»  9 
23  FHIKDI-FHIKOUFNIKOI 

25  CONTINUE 

00  26  K0al,9  $  FNIKOI aFHI KOI /FLOAT! KM AI 

26  TIKDf l»KH«lla(T(KD,l, KHI+FH1KD1 1*0.5 

THIS  IS  TRAPEZ.  NEXT  COMPUTE  ROMBERG 
KM*KN+1  $  KC-1  $  DOEN-1. 

35  KC»KC*1  *  D0EN»D0EN*4. 

DO  37  Lal»9 

CORK  NIL fK Cl a!T! L, KC— 1»KN1—T!L»  KC— 1»KH— l J 1 / ( OOEN-1. 1 
TILfKCfKM laT!l»KC-l»KNI ♦CORKNl LfKCI 
IFIKC. LT.KH.ANO.KC.LT. 101  GOTO  35 

IF IKM.GE. 3 1  GOTO  45  i  KMA-KMA*2  $  GOTO  15 
AFTER  THREE  STEPS  TEST  CONVERGENCE 

45  IFIKM.GE. 201  GOTO  56 
MAXIMUM  OF  20  STEPS  ALLOWED 


00  53  Lal»9 
TEST-ABSICORKMILfKCll 
KC "MINI  KM, 10  I 

IFITEST.LE.1.E-100I  GOTO  53 
IFITEST.LE.ABSITILfKCfKMI IP1.E-10I  60T0  53 
KNA*KNA*2  $  GOTO  15 
53  CONTINUE 

56  00  58  Lal» 9 
58  SF!LlaT!L,KC,KHI*!B-AI 
RETURN 
ENO 
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SUBROUTINE  PR IHI S C R,H I  ST, RHI ST ,NR ) 

C  THIS  IS  CAUEO  FROM  FLOFLO  TO  PRINT  FLOW  HISTORY  AT  OISTANCE  R 

C  R  -  DISTANCE  FROM  THE  EXPLOSION 

C  HI  ST ( 5* 100)  -  TINE*  OVERPRESSURE,  VELOCITY,  DENSITY,  V**2*RH0/2 

C  RHIST 15 , 5, 100  )  -  VARIANCE-COVARIANCE  MATRICES  OF  HIST 

C  NR  -  NUMBER  OF  NODES  IN  HIST 

C 

DIMENSION  HISTt 5, 1001, RHIST (5, 5, 100) 

DIMENSION  £RH(5) ,MES( 5) 

DIMENSION  PRH(5I,NEX<  5 ) ,  NT! 5 > , NU! 5) ,S 1 5 > 

COHMON/CSC ALE/SCO, SCP,SCT 
C 

DO  85  KA«1»NR 
IF!NQ0IKA,35).NE.1>GQT0  4? 

PRINT  25,  R 

25  FORMAT (1H1*/,1H0,20X, 27HFLQW  HISTORY  AT  OISTANCE  R*,1PE12.5> 
IFiSCO.EO.l.) PRINT  26 

26  FORMAT  ! 1H-, 60X, 1HM, /) 

IF1SC0.NE.1. I PRINT  27 

27  FORMAT ! 1H ,, 60X, 3HSC  D, / ) 

PRINT  35 

35  FORMAT I 1H0* /* 1H  , 5X, 3HNR. ,6X, 4HT IME ,4 X, 6HST . ER. , 8X, 

A  9H0VERPRES.  ,2X,6HST.ER.  ,9 X, BHVELOC ITY, 2X, 6HST. ER. , 4X 
B5X,7HDENSITY,3X,6HST.ER.,  7X, 10HU**2*RH0/ 2, 2X, 6HST.ER., / I 
IFISCT.EQ.l.) PRINT  36 

36  F0RNAT!1H*,15X,3H!S),6X,3H!SI I 
IF(SCT.NE.1.)PRINT  37 

37  F0RNATI1H+,14X,5H!SCT >,4X,5H!SCT)t 
IFISCP.EQ.l.) PRINT  38 

38  FORMAT! 1H-,  38X, 4H! PA),6X,4HIPA)> 

IF1SCP.NE.1.)  PRINT  39 

39  FORMAT !1H*,36X,5H!$CP)»4X»5H!SCP)) 

IFCSCT.C0.1..AN0.SCD.EO.1.) PRINT  41 

41  FORMAT! 1H*»63X»5H!H/S)»4X»5H!M/S)I 
IF!SCT.NE.1..0R.SC0.NE.l. )PRINT  42 

42  FORMAT ! 1H*»  67X, 9H! SCD/SCT ) ) 

IF!SCT.EQ. 1* • ANO. SCP.EQ.l.. AND. SC D.EQ.l. ) PRINT  43 

43  FORMAT! 1H* , 91X, 9H! KG/ M**3 ) ) 
IFISCT.NE.1..0R.SCP.NE.1..0R.SCD.NE.1.) PRINT  44 

44  FORMAT! 1H,» 87 X, 19H!SCP4SCTP*2/SCD*P2>  > 

IFISCP.EQ.l.)  PRINT  45 

45  FORMAT!  1H»,  U4X,  4H!PA  )  ,  4X,4H  !P  A  I  I 
IF1SCP.NE. 1.1  PRINT  46 

46  F0RNAT!1H,,113X,5H!SCPI,3X»5H(SCPI> 

47  IF!M0D(KA,5).EQ.1)PR[NT  471 
471  FORMAT ( 1H  I 

MESC-0 

MESS-0 


50  00  479  K8 • 1 , 5 

MESI KB)  -1H 
PRHIKB) «HIST!KB,KA> 
ERH(KB)-SQRTIABS!RHlST!KB,KS,KA))) 
1F!RHIST(KB,K6,KA).LT.0.0)  MESS-1 
55  IF!«HIST!KB,K8,KA).IT.0.0)  ME  S  !K8 I « 1HN 

OM-AMAXH ABS! PRHIKB) ) ,ERH!KBI I 
IFIOM.LE.O.)  N£X!KB)-0 


IFCDN.GT.O. )NEX(KB)»INT(ALQG10(DH)*100.)-100 
PRH(KB)«PRH(KB> /10.**NEX(KB> 

63  ERH(KB)«ERH(K8I/10.**NEX(KB> 

S (KB ) »1H*  $  IF (NE  X( KB ) . IT. 0)  S(KB)«1H- 

NT(KB)«IABS(NEX(KB) )/10  <  NU (KB l-IABS (NEX (KB ll-NT (K8» 

W9  CONTINUE 

65  PRINT  48,KA,(PRH(JI,ERH(.i),S( J)#NT( J)»NU( J)» J-1,5) 

A8  FORK  AT ( 1H  , 3X, I3» 2X, 5 ( 3X» 1H( , 0PF7.4,2H  ,0PF6.4,3H  > E# Alt II, II ) ) 

IF(NESS.EQ.l)  PRINT  49t (HES ( J I t J«l» 5» 

49  FORMAT! 1H ♦ > 9X,5 ( 11 X, A 1, 1 3X ) ) 

IF(HESS.EQ.1IMESC»1 

70  IF(NOD(KA»35).NE.O.AND.KA.NE.NR)GOTO  85 

IF(NE SC •E0>1) PRINT  65 
NESC-0 

65  FORM AT( IHO t lOXt  3  5HNEG ATIVE  VARIANCES  INDICATED  BY  "N") 
IFISCT.E0.1..AND.SCP. EO. 1 .. AND .SCO. EQ.l .» GOTO  85 
75  DENSC«SCP*(SCT/SCD>**2 

PRINT  70#SCTf OENSC 

70  FORMAT ( IHO# lOXt 32HTHE  OUTPUT  IS  SCALED  AS  FOLLOWS* ,//» 1H  ,20X, 

A  4HTIME»10X»5HSCT  «»1PE12.5»2H  St 20Xt 7HDENS ITYt 3X, 

B  18HSCP*(SCT/ SC 01**2  *,1PEI2.5»8H  KG/M**3» 

80  PRINT  75t  SC  Pt  SC  P 

75  FORMAT ( 1H  t20Xtl2H0VERPRESSUREt2Xt5HSCP  »tlPE12.5t 

A  3H  PAt 19X» 16H0YNAMIC  PRESSURE»7X*5HSCP  »»IPE12.5,3H  PA) 
VELSC«SCO/SCT 
PRINT  80*  VELSCt  SCD 

85  80  FORMAT ( 1H  >20X,8HVEL0CITY»2X»9HSCD/SCT  *»1PE12.5*4H  M/S,18X, 

A8HDISTANCEtl5X,5HSC0  ->IPE12.5»2H  M) 

85  CONTINUE 

RETURN 

90  END 
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SUBROUTINE  UTESTC  SCO, SCP , SCT, RUIN* RMAX, RH, TMAX, PAR, VPAR, NPAR, 
A  HIST, VHIST,NRHIST,UrST,NRUTST,NBAD) 

C  THIS  ROUTINE  COMPUTES  TEST  VELOCITIES  UTST  BY  INTEGRATION  ALONG 
C  CONSTANT  TIME  LINES 

C  IT  IS  C ALL EO  FROM  FLOFLO  AFTER  HIST  HAS  BEEN  COMPUTED 
C 

C  ROUTINE  USES  SHOCK,  R0MBIN2  AND  UTINT 
C 

DIMENSION  PARC10),VPARC10,10),HIST< 5,2) ,VHIST( 5,5,11 , UTST III 
C0MM0N/AM8CHA/APRE,ATEM, AGAM,ADUM(5) 

COMMON /COUTST/TIME,CP ARC  10), CAGAH,CAPRE 
EXTERNAL  UTINT 
C 

NBAD»0 

CAGAM-AGAM  S  CAPRE- APRS /SCP 
00  10  KA-1,10 
10  CPAR(KA)-PARCKA) 

NRUTST-0 

IFCNRH1ST.LE.0)  RETURN 
NRUTST-1 

UTSTC  1)«HISTC3,1)  I  IF  C  NRHI S  T.EO.  i)  RET  '•  I 
IF(RH.GE.RMAX)  RETURN 
RD-RH*SC0  $  Rl-RO 

CALL  SH0CK(RD,T1,P0V»  USH, UP, RH0,LBA0) 

IFCLBAD.EQ.O)  GOTO  25 

12  NBAD«100*IABS<L8AD)510*NRUTST 

13  PRINT  15, NB AO 
RETURN 

15  FORMAT! 1H0, 10X,28HRETURN  FROM  UTEST  WITH  NBAD-I6) 

C 

25  DTIMD-(HISTI1#2)-HIST(1,1))*SCT 

TD*HIST  ll,2)*SCT 
27  R2-R1»DTIMD*USH 

CALL  SHOCK CR2,T2,P0V» USH, UP, RHO»LBAD) 

IF(LBAD.NE.O)  GOTO  12 
C 

C  AT  35  START  REGULA  FALSI  ALGORITHM  TO  FIND  PROPER  R 
C  SUCH  THAT  SHOCK  ARRIVES  AT  GIVEN  TIME  TD  AT  R 
35  R3«R2MTD-T2)*(R2-R1)  /CT2-T1) 

CALL  SHOCK(R3,T3,POV, USH,UP,RHO,LBAO) 

IF(LBAO.NE.O)  GOTO  12 
IFCABS<T3-TO).LE.DTINO*O.Ol>  GOTO  51 
R1-R2  %  T1-T2  $  R2«R3  $  T2»T3 

GOTO  35 
C 

51  RS-R3/SC0  $  TIME-T3/SCT 

CALL  R0MBIN2IUTINT,RH,RS,UIN,LBAD) 

C  QUADRATURE  TO  COMPUTE  TEST  VELOCITY 
IFCLBAD.EQ.O)  GOTO  55 
NBAD*200+I ABSCLBA0)*10+NRUTST 
GOTO  13 
C 

55  NRUTST«NRUTST*1 

UTST <NRUTST)«UP*< SCT/ SCO) *CRS/RH)**2 
A  *C(P0V/SCP»CAPRE)/CHIST(2,NRUTST)*CAPRE))**C1./AGAM) 

B  ♦UIN/I  AGAMPRH**2*fHIST<2,NRUTST)*CAPRE)*M  l./AGAM)) 

C  THIS  IS  THE  NEW  TEST  VELOCITY 
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1  SUBROUTINE  UTINT ( X, F,  NBAD ) 

C  INTEGRAND  ROUTINE  FOR  TEST  VELOCITY  COMPUTATION 
C 

C OHM ON/COUTST/TH»  PARI  10) » GAM»  APRE 

5  DIMENSION  XXI 3, 1 ),FX< 3>*FP< 10) ,FXX( 3, 3* »FXP (3. 10 >,FPP< 10. 10 1 

C 

XXll.U-TH  %  XX I  2. I ) *0  S  XX(3,1J«X 

CALL  PFIELDCIXX.l.PAR.FF.FX.FP.FXX.FXP.FPP.NBAD) 

IFINBAO.NE.O)  RETURN 

10  F«X**2P(FF*APRE I ♦*< !• /GAM-1. )*FXI1> 

RETURN  S  END 
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SUBROUTINE  R0M8IN2  (F*A,B*FINT»NBAD» 

C  ROMBERG  INTEGRATION  SUBROUTINE 
C 

DIMENSION  T(10»20>#C0RKM<10» 

C 

NBAD*0 

CALL  F<A#  .»NBAD )  S  I F (NB AO.NE . 0) RETURN 
CALL  F(  8»  FB#NBAO )  %  I F(N8AD.NE .0) RETURN 
TC1»1)*(FA>FB)*0.5 
KM*1  t  KMA-1 
C 

IS  OEM* FLOAT ( KMAI*2«  $  FM-0 
00  25  KA*1,KMA 
AC-FLOAK 1*2* ( KM A-K A ) J/DEN 
BC*FL0AT(2PKA-1I/0EN 
ARG»AC*A+BC*B 

CALL  F( ARG>FN>NBAD)  J  IF l NB AO . NE. 01  RETURN 
FN«FH*FN 
25  CONTINUE 

FM-FM/FLOATIKMA) 

TCl,KH*l)-mi#KMI*FMl*0.5 
C  THIS  IS  TRAPEZ.  NOM  COMPUTE  ROMBERG 
KM-KM*1  l  KC*1  %  ODEN *1  • 

C 

35  KC-KC+1  $  D0EN-DDEN*4. 

CORKM(KC) *  (  T< KC— 1»KH>— T (KC— 1»KM—1I I /I  DO EH— 1* ) 

T(KC, KMJ-T<KC-1,KMI*C0RKM(KCI 
IFIKC.LT.KM.ANO.KC.LT.IOIGOTO  35 
I F(KC  «GE«3 I  GOTO  45 

C  AFTER  AT  LEAST  3  STEPS  BRANCH  TO  45  AND  TEST  CONVERGENCE 
KMA«KNA*2  %  GOTO  15 
C 

45  DO  55  KA-2>KC 

TEST*  ABS(CORKM(KAI I 

IFCTEST.LE.ABS(T<KC»KM) ) *1. E-10) GOTO  65 
IF<TEST.LE.1.E-100)G0T0  65 
55  CONTINUE 

IF(KM.GE.20)G0T0  65 

C  COMPUTE  NOT  MORE  THAN  20  R0M8ERG  CORRECTIONS 
KMA*KMA#2  %  GOTO  15 
C 

65  F INT  *T(KC»KMI*<  B— Al 
RETURN 
END 
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SUBROUTINE  PR ITST ( R, R WAX, HI  ST# VHIST»NRH 1ST, UTST, NRUTST  ) 


5 


10 


c 

C  THIS  ROUTINE  PRINTS  THE  TEST  VELOCITIES  UTST  TOGETHER  WITH 
C  CORRESPONDING  VELOCITIES  FROM  THE  ARRAY  HIST 
C  AND  THE  DYNAMIC  PRESSURE  COMPUTED  USING  THE  TEST  VELOCITY 
C 

DIMENSION  HIST!5>1)»VHIST!5»5»1)»UTSTI1) 

C 

COMMON/CSC  ALE /$CD»SCP*SCT 

IF!NRUTST.LE.O)RETURN 
IFINRHIST <LE<20)  PRINT  8 
8  FORMAT! IH  ,/////) 


15 


20 


25 


30 


35 


<.0 


DO  55  K A« 1» NRUTS T 
IFIN00!KA,35).NE.1>G0T0  35 
IF<NRHIST<GT< 20)  PRINT  II 
11  FORMAT (IH1 ) 

PRINT  15  t R 

15  FORMAT ( 1H  »20X,32HTEST  VELOCITIES  FOR  DISTANCE  R  «»1PE12.5> 
IF!SCD<EQ<1<) PRINT  151 

151  F0RMAT!1H*>65X*1HM»/) 

IF(SCD<NE<1<) PRINT  152 

152  FORMAT <  1H*»  65X»  3HSC0» / ) 

PRINT  153 

153  FORMAT! 1H  , 83X,*0YNANIC  PRESSURE*) 

PRINT  35 

35  FORMAT  1 1H  ,10X,2HNR,  7X,5HTINE»  8X» 8HVEL0CITY,2X, 

A  6HST.ER.,9X»9HT£ST  VEL.,2X»6HUTST-U> ) 

PRINT  350 

350  FORMAT! 1H5#  85  X» 13HUTS  T**2*RH0/2# ) 

IF<SCT<EQ<1<1PRINT  351 

351  FORMAT ! 1H  ,20X,3H!$II 
IF(SCT<NE  < 1 • ) PR INT  352 

352  FORMAT! 1H  » 19X, 5H< SCT I ) 

IF!SCT.EQ.1..AN0.SCD.EQ.1.)PRINT  353 

353  FORMAT  <lH+r33X;5H<M/S)»3Xr5H<M/SI»L2X»5H(NSS)»5Xr5HIM/S)) 
IFISCT<NE<1<< OR < SC 0<NE<1< )PRINT  355 

355  FORMAT! 1H+, 37X, 9H< SCD/SCT ) , 16X,9H!SC0/SCT) ) 

IFISCP<EQ<1<1  PR INT  355 

355  FORMAT! 1H5»88X»5H!PA1  I 
IF<SCP<NE<1<1PRINT  356 

356  FORM AT!1H>»88X»5H!SCP)) 


55  35  IF!M0D!KA,5).EQ.1)PRINT  33 

33  FORMAT  <1H  ) 


TIN-HIST! 1»  KA ) 

E  R  U*  S  Q  R  T  ( ABS(VHIST!3»  3  »  K  A  )  )  ) 

50  U-HI ST! 3»  KA )  %  UT-UTSTUA) 

U0«UTST!KA>-HIST!3»KA1 
SU0-1H*  %  IF!UO.LT.O.)  SUD-1H- 

0M«AMAX1!ABS(U),ERU,ABS!UT),ABS!U0) ) 
IF<DM<LE<0<  )  NE  X-0 

55  IF!DN.GT.0.1NEX-INTIAL0G10!DM>*100. )-100 

NT-I ABS!NEX)/10  %  NU- I ABS < NE X >-NT 
SNEX" 1H*  *  IF!NEX.LT.O)  SNEX-1H- 
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fct«io.**nex 

U-U/FCT  $  ERU-ERU/FCT  $  UT-UT/FCT  $  ABUD»ABS<UD)/FCT 
PRINT  36*KA,TIM,U»ERU»SNEX»NT, NU*UT,SUD,ABUD»SNEX,NT»NU 
FORMAT  ( 1H  >  8X»I4»3X»1PE12.5»3X»1H(»0PF7.4>2H  »0PF6.4»3H  )E 

A  A1*I1*I1*4X*1H(*0PF7.4*2X*A1* OPF  6. 4*  3H  )E*A1*U*I1) 

RHO»HIST(4»KA)$  DYP«UTST(KA)**2*RHO/2. 

PRINT  361* OTP 

361  FORMAT (1H*»85X»1PE11.4) 

IF(MOO(KA»35) .NE.O.AND.KA.NE.NRUTST )GOTO  55 
IFCSCT.E0.1..AN0.SC0. EO.l. )GOTO  55 
VELSC-SCD/SCT 
PRINT  45*  SCO*  SCT*  VELSC 

45  FORMAT ( 1HO* 15X*  32HTHE  OUTPUT  IS  SCALED  AS  FOLLOWS:* 

A  10X* 8H0I STANCE* 10X*  5HSCD  «#1PE12.5*2H  M ,/» 

B  1H  » 57X,4HTIME*14X,5HSCT  -#1PE12.5*2H  S,/» 

C  1H  ,  57X,8HVELOCITY»6X»<)HSCD/SCT  »*1PE12.5*4H  M/S) 

PRINT  451*  SCP 

451  FORMAT ( 1H  »57X»16H DYNAMIC  PRESSURE* 2X> 5HSCP  ■» 1PE 12 . 5* 3H  PA) 
CONTINUE 

IF(NRHIST.LE.NRUTST)  RETURN 
PRINT  65*  RMAX 

FORMAT! 1HO* 10X*  22HTES  T  VELOCITIES  CANNOT* 

A  36H  BE  COMPUTED  FOR  LATER  TIMES  BECAUSE*  6H  RMAX-* 1PE12. 5* 

B  31H  LIMITS  THE  COMPUTATIONAL  RANGE) 

RETURN  S  END 
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SUBROUTINE  PLFF LD( SCO* SCP, SCT, D,HIST, RHIST* NR, UTST, NRUTST* T ITL E ) 

THIS  ROUTINE  PLOTS  THE  FOLLOWING  FLOW  VARIABLES 

OVERPRESSURE  VERSUS  TIME 

VELOCITY  VERSUS  TIME 

DENSITY  VERSUS  TIME 

OYNAMIC  PRESSURE  VERSUS  TIME 

DYNAMIC  PRESSURE  FROM  TEST  VELOCITY  VERSUS  TIME 
TEMPERATURE  VERSUS  TIME 


SCO*  SCP»SC T 
D 

HI$T(5,NR) 
RHIS  T ( 5*5  »NR ) 
UTST (NRUTST) 


SCALES  OF  DISTANCE*  PRESSURE*  TINE 
DISTANCE  FROM  EXPLOSION 

FLOW  FIELD  HISTQRYtT* P,U,RHO»U**2*RHOT2) 
VARIANCE  COVARIANCE  MATRICES  OF  HIST 
PARTICLE  VELOCITIES  COMPUTED  BY  TEST  PROCESS 


DIMENSION  HIST(5,1C0)»RHIST(5,5,100)»TEMP(8) 

DIMENSION  X(102),  XA(IOO)*  Y<102  I*  YKIOO)  ,  Y2(  100 » 
DIMENSION  TITLE ( 3) 

DIMENSION  UTST(IOO) 

COMMON/ AM BCHA/  PO. TO* G, M» VC* EC 
C  OMMQN/PL  OT/AP, AH*  Z(4)*PLABL!4) 

REAL  M 

CALL  PL T3 EG (8. 7, 11.2*  X.O, 13, PLABL) 

THIS  SECTION  PLOTS  OVERPRESSURE  VERSUS  TIME 

X(1)»HIST (l*l)-0.1*(HIST(l,NR)-HISTIl*l) ) 

Y!1)*0. 

X!2)*HIST (1,1) 

Y(2)«Y(1) 

DO  50  I«1,NR 
X  ( 1*2  I “HIST ( I»I ) 

Y(I*2)«HIST(2,IMY!1I 
EY»SORT!ABS (RHIST ( 2*2*1))) 

YKI  )«Y(I»2I-AH*EY 
Y2(I)»Y(I*2)>AH*EY 
XA  (I  )  "H IS  T  (  1,  I ) 

50  CONTINUE 
N«NR*2 

CALL  FIXSCA(X*N*5.0*XS*XMIN*XMAX*DX) 

CALL  GRAPH ( Y, Yl, Y2» XMIN, XMAX, YMIN,YMAX» XS, YS*DX,D,SCO, 
A  AH,SCT, TITLE, N) 

CALL  PLTWN0(XMIN,XMAX,YMIN, YMAX) 

ENCODE! 80*90, TEMP) 

90  FORMAT! 18H0VERPRESSURE  !PA)>) 

IFISCP.NE.l.) ENC  0DE(80,91,TEMP ) 

91  FORMAT! 19H0VERPRESSURE  !SCP)>) 

TX«XMIN-0.7*XS 

TY«! YMAX*YMIN)*0.5-8. 5*0. 1*YS 
CALL  PLTSYM(0.1*TEMP*  90., TX*TY ) 

CALL  PLT0TS!1,0,X,Y,N,0) 

CALL  PLTDTS!1»0,XA,Y1,NR,0) 

CALL  PLT0TS(1»0»XA*Y2»NR*0) 

CALL  PLTPGE 

THIS  SECTION  PLOTS  VELOCITY  VERSUS  TIME 
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c 


60 


65 


70 


75 


80 


85 


90 


95 


100 


105 


110 


C 

C 

C 


C 

C 

C 


Y<1)  *0.0 
Y<2)  *Y<  1) 

00  100  1*1# NR 
Y ( 1*2 ) *HIST I  3# I ) 

EY<SQRTUBS<RHIST<  3#3»I)n 
Y1<I )-Y!I*2)-AH*EY 
Y2<I  ) *Y  <1 *2  )♦ AH*E Y 
100  CONTINUE 

CALL  GRAPH<Y»Y1,Y2»XMIN,XMAX» YMIN»YMAX» XS» YS» DX#0»SC0, 

A  AH#  SCT»TITLE»N) 

CALL  PLTWNOUMIN, XMAX,  YMIN,  YMAX) 

ENCODE! 80# 110# TEMP) 

110  F ORMAT U5HVEL0CITY  <N/S)>) 

IF<SCT.NE.1..0R.SC0.NE.l. )ENCOOE <80# 111# TEMP  I 

111  FORMAT < 19HVEL0C ITY  <SCD/SCT>>) 

TY*< YMAX+YMIN)*0.5-7.0*0.1*YS 
CALL  PLTSYN<0.1#TEMP# 90.#TX#TY) 

CALL  PLTDTS<1»0,X,Y,N,0> 

CALL  PLT0TS<1»0»XA» Y1»NR#0) 

CALL  PLT0TS<1#0#XA#Y2#NR#0) 

CALL  PLT0TS<4»0»XA»UTST,NRUTST»0) 

CALL  PLTPGE 

THIS  SECTION  PLOTS  OENSITY  VERSUS  TIME 

Y<1)-<N/8.3143)*<P0/T0>*!SCD/SCT)**2*<1./SCP) 

Y<2)«Y<1) 

DO  120  1*1 » NR 
Y<I*2)-HIST<4,I) 

EY-SQRT<ABS<RHIST< 4,4,1))  ) 

Y1<I)*Y<I*2 )— AH*E Y 
Y2<I ) *Y  <1*  2 )*AH*EY 
120  CONTINUE 

C  ALL  GR APH<  Y, Yl, Y2#  XM IN, XMAX#  YMIN, YHAX, XS#  YS*  OX, 0, SCO, 

A  AH.SCT, TITLE, N) 

CALL  PLTWND<XMIN, XMAX, YMIN, YHAX) 

ENCODE  <80, 130, TEMP) 

130  FORM  AT  < 18HDENSITY  <KG/M**3>>> 
IF<SCT.NE.l..OR.SC0.NE.l..OR»SCP.NE«l« ) ENCODE  <8 0,131, TEMP) 

131  FORMAT! 27 H DENSITY  < SC P*<SCT/SC D)**Z >> > 

TY«< YMAX+YM IN )*0. 5-8. 5*0.1* YS 

CALL  PLTSYM!0.1,TEMP,90.,TX,TY) 

CALL  PLTDTS<1,0,X,Y,N,0» 

CALL  PLTDTS<1,0, XA,Y1,NR,0) 

CALL  PLT0TS<1»0»XA»Y2»NR»0) 

CALL  PLTPGE 

THIS  SECTION  PLOTS  DYNAMIC  PRESSURE  VERSUS  TIME 

Y  < 1) -0.0 
Y<  2)  *  Y<  1) 

DO  140  1*1, NR 
Y < 1*2 ) -HIST  <5, I ) 

EY-S QRT<A3S<RHIST< 5,5,1) ) ) 

YUI)-Y<I»2)-AH*EY 
Y2<I)*Y<I*2 )♦ AH*EY 
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115 


1*0  CONTINUE 

CALL  GRAPHiy,Yl,Y2,XMIN,XMAX»YMIN,YMAX,XS,YS,DX,D,SCD, 
A  AH,  SCT»TITLE»NI 
CALL  PL  TWND! XMIN,  XMAX  , YMIN, YNAX) 

ENCODE! 80, 150*TEN?) 

FORMAT! 33HDYNAMIC  PRESSURE  RH0*V**2/2  IPA>>) 

I F (S CP. NE.l.t ENCODE (80,151. TEMP) 

FORMAT! 3AH0YNAMIC  PRESSURE  RH0*V**2/2  !SCP)>» 

TY«!  YMAX+YMIN)*0. 5-16. 0*0. 1*YS 
CALL  PLTSYM!0.1,T£MP»90.»TX»TY) 

CALL  PLTDTS!1,0,X,Y,N,0I 
CALL  PLTDTS<1,0,XA, Y1,NR»0) 

CALL  PLT0TS!1,0,XA,Y2.NR,0) 

CALL  PLTPGE 

THIS  SECTION  PLOTS  DYNAMIC  PRESSURE  FROM  TEST  VELOCITY 
VERSUS  TIME. 

Y ( 1) *0. $  Y121-YI1) 

DO  160  I*1,NRUTST 
Y!I*2I«HIST!*,II*UTST!I )**2/2. 

CONTINUE 

BH—2.S  NT«NRUTST*2 

SETTING  THE  ERROR  FACTOR  BH*-2  INDICATE  FOR  GRAPH 
C  THAT  FOR  THIS  PLOT  THE  SAME  SCALES  AS  PREVIOUSLY  SHOLD 
1*0  C  BE  USED,  AND  THAT  TITLE  OF  PLOT  SHOULD  BE  DIFFERENT 

CALL  GRAPH!Y,Y1,Y2,XMIN,XMAX,YMIN,YMAX,XS,YS,DX,D,SCD, 
A  BH.SCT, TITLE, NT) 

CALL  PLTWND!XNIN»XMAX,YNIN,YMAX) 

ENCODE { 80, 170, TEMP) 

1*5  170  FORMAT! 33HDYNAMIC  PRESSURE  RH0*V**272  !PA)>) 

IFfSCP.NE.l.) ENCODE! 8 0,171, TEMP) 

171  FORMAT! 3AH0YNAMIC  PRESSURE  RH0*V**2/2  !SCP>>) 

TY*I  YMAXUMIN  1*0.5-16. 0*0. 1*YS 
CALL  PLTSYM! 0.1, TEMP, 90. , TX, TY 1 
150  CALL  PLT0TS!1,0,X,Y,NRUTST, 01 

CALL  PLTPGE 


120 


150 

151 


125 


130 


C 

C 


135 


160 
C  BY 


155 


160 


165 


170 


C  THIS  SECTION  PLOTS  TEMPERATURE  VERSUS  TIME 
C 

Yll) -TO 
Y!2)  *Y!  II 
C 

DO  180  1*1, NR 
PR«HIST!2»I)*SCP*P0 
C  PRESSURE  IN  SI  UNITS 

RO*HIST !*,I)*SCP*!SCT/SCD)**2 
C  DENSITY  IN  SI  UNITS 

Y < 1*2 )*PR*M/!R0*8. 31*3) 

C  THIS  IS  TEMPERATURE* PRES  SURE*! MOLAR  MASS  1 1  DENS ITY  IN  KELVINS 
EY*Y! 1*21 *SORT!RH 1ST! 2,2, I ) *1 SCP/PR 1**2 
*  A  -2. 0*RHIST!2,*,I)*SCP/!PR*HIST!*,I)) ♦RHIST (*,*, D/HIST!*, 11**2) 
Y 1 1 1 1 *Y!I*2)-AH*EY 
Y2!I l*Y!I«-2)*AH*EY 
180  CONTINUE 
C 

CALL  GRAPH !Y,Y1,Y2,XMIN,XMAX,YMIN,YMAX,XS,YS,DX,D,SC0, AH, SCT, 
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A  TITLE*  N) 

CALL  PLTWNOCXMIN,XMAX,YMIN,YMAX> 
ENCODE< 80, 190, TEMP) 

175  190  FORMAT  < 16HTEMPER ATURE  (Kl>» 

TY»(  YMAX*YMIN)*0. 5-8. 0*0.  1*V$ 
CALL  PL TSYMIO.l, TEMP, 90.0, TX,TY) 
CALL  PLTDTS(1,0,X,Y,N«0) 

CALL  PLTDTS(1,0,XA,Y1,NR,0I 
180  CALL  PLTDTS(l,0,XA,Y2« NR, 0 t 

CALL  PLTPGE 
C 

RETURN 

END 


SUBROUTINE  6R APHl Y, Y1 , Y2, XM IN, XMAX, YMIN, YN AX, XS»  YS» 0 X, 0, SCO. 

A  AH, SCT*TITLE»N) 

C  AUXILIARY  ROUTINE  OF  PLFFLD  FOR  ESTABLISHING  SCALES  ETC. 

C  IT  IS  CALLED  FROM  PLFFLO 

DIMENSION  Ytl02l»Yltl00l,Y2(100),TITLEt 3) 

DIMENSION  TEMPI  8  I 

IFIAH.LT. ~1. I  GOTO  35 

C  IF  ERROR  FACTOR  IS  NEGATIVE  THEN  THIS  IS  A  PLOT  OF 
C  THE  DYNAMIC  PRESSURE  FROM  TEST  VELOCITY.  IN  THIS  CASE 
C  USE  THE  SAME  SCALES  AS  FOR  PREVIOUS  PLOT 
CALL  FIXSCAtY»N»4.0»YS»YMIN»YNAX»DY) 

CALL  C0NSCA!Yl,N-2,4. 0*YS,YMIN*YMAX,DY) 

CALL  C0NSCAIY2»N-2,4. 0. YS»YMIN, YMAX,DYI 
35  CONTINUE 

CALL  PLTSCAI2.5»4.0»XNIN»YMIN»XS»YS) 

CALL  PLTAXSIDX,DY»XMIN»XNAX»YMIN,YNAX»4I 
CALL  LABAX10X*2.»DY*2.»XNIN,XMAX,YNIN»YMAX> 

ENCODE! 80 *50, TEMP)  TITLE 
50  FORM  ATI  3 A1 0*1 H> I 

TX-I XMAX*XMIN)*0. 5-15. 0*0. 1*XS 
TY«YMAX*1.0*YS 

CALL  PLTSYMI0.1»TEMP»0.0*TX»TY) 

IFISCD.EQ.l. ) ENCODE  1 8 0*60* TEMP)  D 
60  FORM ATI  28 HOT STANCE  FROM  THE  EXPLOSION  ,F7.2,8H  METRES* ) 
IFISCD.NE.l.)  ENCODE! 80* 61*  TEMPI  D 
61  FORMAT! 28 HOIST ANCE  FROM  THE  EXPLOSION  »F7.2»8H  ISCDI  >1 

TX-I XNAX*XMINI*0. 5-22. 0*0. 1*XS 
TY-YMAX*. 75*Y$ 

CALL  PLTSYMI0.1»TEMP»0.0»TX»TY) 

IFIAH.LT.-l, JGOTO  72 

ENCODE! 80 *70# TEMP  I  AH 

70  FORM  ATI *ERROR  LIMITS  CORRESPOND  TO  *,F5.2,*  STANDARD  ERRORS**) 
TX-I XMAX+XMIN)*0. 5—24 .0*0.1*XS 
TY-YMAX*0. 5*YS 

CALL  PLTSYMIC.1,TEMP,0.0,TX,TY) 

GOTO  78 

72  ENCODE! 80*73, TEMPI 

73  FORMAT! 46HDYNAMIC  PRESSURE  COMPUTED  USING  TEST  VELOCITY*) 

TX-I XMAX*XMINI/2.— 23. 0*0. 1*XS 

TY«YMAX*0.5*YS 

CALL  PLTS YMIO.l* TEMP, 0.0,TX,TY) 

78  CONTINUE 

ENCODE  I  80*  80* TEMP  I 

80  FORMAT  I 9HTIME  I S I > I 
IFISCT.NE.l. I  ENCODE  180, 81, TEMP) 

81  FORM  ATI  HHT IME  ISCTI*) 

TX-I XMAX*XNIN)*0. 5-5. 0*0. 1*XS 
TY-YMIN-O. 5*YS 

CALL  PLTS YMIO.l, TEMP, 0.0,TX,TY) 

RETURN 

END  235 


LIST  OF  SYMBOLS 


a,  b,  c,  d 
A,  B,  C 

A(r),  B(r),  C(r) 

^*1 

c 

o 

cab'  c12'  etc- 
e 

E 


-  shock  fitting  parameters. 

-  fitting  parameters  of  a  single  overpressure  history 

-  functions,  defined  by  Equation  6.3. 

-  overpressure  field  fitting  parameters. 

-  sound  speed  in  ambient  air,  m/s. 

-  correlation  coefficients. 

-  specific  internal  energy,  JAg* 

-  effective  energy  released  by  the  explosion,  J. 


-  standard  error  of  the  quantity  in  the  index. 


h 

H 

M 

P 

P 


Pf(r,  t;  A^,  A2, 

Bl'  B2'  Cl> 
Ph(t;  A,  B,  C) 

Pg(r;  a,  b,  c) 

Q 

r 

r 


V  v  st 


ts  (r;  a,  b,  c,  d) 


-  elevation  of  the  pressure  probe,  m. 

-  elevation  of  the  center  of  the  explosion,  m. 

-  molar  mass,  kg/tool. 

-  pressure.  Pa. 

-  ambient  pressure.  Pa. 

-  fitted  overpressure  field  function. 

-  fitted  overpressure  history  function,  Pa. 

-  fitted  shock  overpressure  function.  Pa. 

-  exponent  in  Equation  4.3. 

-  distance  from  the  center  of  the  explosion,  m. 

-  a  reference  distance  used  in  shock  fitting,  m. 

-  distance  pressure  and  time  scales  used  in  the 
calculations,  m.  Pa,  s. 

-  time  after  the  explosion,  s. 

-  fitted  shock  arrival  time  function,  s. 


T 


-  ambient  temperature,  K 


DISTRIBUTION  LIST 


No.  of 

Copies  Organization 


12  Commander 

Defense  Technical  Info  Center 
ATTN:  DTIC-DDA 
Cameron  Station 
Alexandria,  VA  2231*1 

1  Director  of  Defense 

Research  A  Engineering 
ATTN:  DD/TWP 
Washington,  DC  20301 

1  Asst,  to  the  Secretary  of 
Defense  (Atomic  Energy) 

ATTN:  Document  Control 
Washington,  DC  20301 

1  Director 

Defense  Advanced  Research 
Projects  Agency 
ATTN:  Tech  Lib 
1400  Wilson  Boulevard 
Arlington,  VA  22209 

2  Director 

Federal  Emergency  Management 
Agency 

ATTN:  D.  A.  Bettge 

Technical  Library 
Washington,  DC  20472 

1  Director 

Defense  Intelligence  Agency 
ATTN:  DT-2/Wpns  A  Sys  Div 
Washington,  DC  20301 

1  Director 

National  Security  Agency 
ATTN:  E.  F.  Butala,  R15 
Ft.  George  G.  Meade,  MD  20755 

1  Director 

Joint  Strategic  Target 
Planning  Staff  JCS 
Offut  AFB 
Omaha,  NB  68113 


No.  of 

Copies  Organization 

1  Director 

Defense  Communications  Agency 
ATTN:  930 

Washington,  DC  20305 

9  Director 

Defense  Nuclear  Agency 
ATTN:  DDST 

TIPL/Tech  Lib 
SPSS/K.  Goering 
SPTD/T.  Kennedy 
SPAS/P. R.  Rohr 
G.  Ullrich 
STSP/COL  Kovel 
NATD 
NATA 

Washington,  DC  20305 

2  Commander 

Field  Command,  DNA 
ATTN:  FCPR 

FCTMOF 

Kirtland  AFB,  NM  87117 

1  Commander 

Field  Command,  DNA 
Livermore  Branch 
ATTN:  FCPRL 
P.0.  Box  808 
Livermore,  CA  94550 

1  HQDA 

DAMA-ART-M 

Washington,  DC  20310 

1  Program  Manager 

US  Army  BMD  Program  Office 
ATTN:  John  Shea 
5001  Eisenhower  Avenue 
Alexandria,  VA  22333 


239 


DISTRIBUTION  LIST 


No.  of 
ies 


Organization 


No.  of 
ies 


issa 


Organization 


Director 

1 

Commander 

US  Army  BMD  Advanced 

Naval  Weapons  Center 

Technology  Center 

ATTN:  Tech  Svcs  Br,  Code  3**33 

ATTN:  CRDABH-X 

CRDABH-S 

China  Lake,  CA  93555 

Huntsville,  AL  35807 

1 

US  Army  MERADC0M 

ATTN:  DRDME-EM,  D.  Frink 

Commander 

US  Army  BMD  Command 

Fort  Belvoir,  VA  22060 

ATTN:  BDMSC-TFN/N. J.  Hurst 

1 

Commander 

P.0.  Box  1500 

US  Army  Materiel 

Huntsville,  AL  35807 

Command 

ATTN:  AMCDRA-ST 

Commander 

5001  Eisenhower  Avenue 

US  Army  Engineer  Division 

ATTN:  HNDED-FD 

Alexandria,  VA  22333 

P.0.  Box  1500 

1 

Commander 

Huntsville,  AL  35807 

Armament  R&D  Center 

US  Army  AMCCOM 

Deputy  Chief  of  Staff  for 

ATTN:  SMCAR-TDC 

Operations  and  Plans 

ATTN:  Technical  Library 

Dover,  NJ  07801 

Director  of  Chemical 

2 

Commander 

&  Nuc  Operations 

Armament  R&D  Center 

Department  of  the  Army 

US  Army  AMCCOM 

Washington,  DC  20310 

ATTN:  SMCCR-LCN-F,  W.  Reiner 
SMCCR-TSS 

Office,  Chief  of  Engineers 
Department  of  the  Army 

Dover,  NJ  07801 

ATTN:  DAEN-MCE-D 

1 

Commander 

DAEN-RDM 

US  Army  Armament,  Munitions 

890  South  Pickett  Street 

and  Chemical  Command 

Alexandria,  VA  22304 

Commander 

ATTN:  SMCAR-ESP-L 

Rock  Island,  IL  61299 

US  Army  Engineer 

1 

Director 

Waterways  Experiment  Station 

Benet  Weapons  Laboratory 

ATTN:  Technical  Library 

Armament  R&D  Center 

Jim  Watt 

US  Army  AMCCOM 

Jim  Ingram 

ATTN:  SMCAR-LCB-TL 

P.0.  Box  631 

Vicksburg,  MS  39180 

Watervliet,  NY  12189 

DISTRIBUTION  LIST 


No.  of 

Copies  Organization 

1  Commander 

Naval  Electronic  Systems  Com 
ATTN:  PME  1 17-21 A 
Washington,  DC  20360 

1  Commander 

Naval  Facilities  Engineering 
Command 

Washington,  DC  20360 

1  Commander 

Naval  Sea  Systems  Command 
ATTN:  SEA-62R 
Department  of  the  Navy 
Washington,  DC  203&2 

3  Of ficer-in-Charge(Code  L31) 
Civil  Engineering  Laboratory 
Naval  Constr  Btn  Center 
ATTN:  Stan  Takahashi 
R.  J.  Odello 
Technical  Library 
Port  Hueneme,  CA  93041 

1  Commander 

David  W.  Taylor  Naval  Ship 
Research  &  Development  Ctr 
ATTN:  Lib  Div,  Code  522 
Bethesda,  MD  20084 

1  Commander 

Naval  Surface  Weapons  Center 
ATTN:  DX-21 ,  Library  Br. 
Dahlgren,  VA  22448 

2  Commander 

Naval  Surface  Weapons  Center 
ATTN:  Code  WA501/Navy  Nuclear 
Programs  Office 
Code  WX21/Tech  Library 
Silver  Spring,  MD  20910 


No.  of 

Copies  Organ iza t ion 

1  Commander 

Naval  Weapons  Evaluation  Fac 
ATTN:  Document  Control 
Kirtland  AFB,  NM  87117 

1  Commander 

Naval  Research  Laboratory 
ATTN:  Code  2027,  Tech  Lib 
Washington,  DC  20375 

1  AFIT  (Lib  Bldg.  640,  Area  B) 
Wright-Patterson  AFB 
Ohio  45433 


1  AFSC/SDOA 

Andrews  Air  Force  Base 
MD  20334 

1  AFATL/DIDDL,  Tech  Ub 

Eglin  AFB,  FL  32542  -5000 

1  AFWL/SUL 

Kirtland  AFB,  NM  87117 

1  AFATL  (DLYV) 

Eglin  AFB,  FL  32542  -5000 

1  RADC  (EMTLD/Docu  Libray) 
Griffiss  AFB,  NY  13441 

1  AFWL/NTES  (R.  Henny) 
Kirtland  AFB,  NM  87117 

T  AFWL/NTE,  CPT  J.  Clifford 
Kirtland  AFB,  NM  87117 

2  Coramander-in-Chief 
Strategic  Air  Command 
ATTN:  NRI-STINFO  Lib 
Offutt  AFB,  NB  68113 


DISTRIBUTION  LIST 


No.  of  No.  of 

Copies  Organization  Copies  Organization 


1  Commander 

US  Army  Aviation  Research 
and  Development  Command 
ATTN :  AMSAV-E 
4300  Goodfellow  Boulevard 
St.  Louis,  MO  63120 

1  Director 

US  Army  Air  Mobility  Research 
and  Development  Laboratory 
Ames  Research  Center 
Moffett  Field,  CA  94035 

1  Commander 

US  Army  Communications- 
Electronics  Command 
ATTN:  AMSEL-ED 
Fort  Monmouth,  NJ  07703 

3  Commander 

US  Army  Electronics  Research 
and  Development  Command 
ATTN:  DELSD-L 

AMDSD-E,  W.  S.  McAfee 
AMDSD-EI,  J.  Roma 
Fort  Monmouth,  NJ  07703-5301 

7  Director 

US  Army  Harry  Diamond  Labs 
ATTN:  Mr.  James  Gaul 

Mr.  L.  Belliveau 
Mr.  J.  Meszaros 
Mr.  J.  Gwaltney 
Mr.  Bill  Vault 
Mr.  R.  J.  Bostak 
Mr.  R.  K.  Warner 
2800  Powder  Mill  Road 
Adelphi,  MD  20783 


4  Director 

US  Army  Harry  Diamond  Labs 
ATTN:  DELHD-TA-L 

DRXD0-TI/002 

DRXDO-NP 

DELHD-RBA/J.  Rosado 
2800  Powder  Mill  Road 
Adelphi,  MD  20783 

1  Commander 

US  Army  Missile  Command 

ATTN:  AMSMI-R 

Redstone  Arsenal,  AL  35898 

1  Commander 

US  Army  Missile  Command 
ATTN:  AMSMI-YDL 
Redstone  Arsenal,  AL  35898 

3  Commander 

US  Army  Natick  Research  and 
Development  Center 
ATTN:  DRXRE/Dr .  D.  Sieling 
DRXNE-UE/A.  Johnson 

J.  Calligeros 
Natick,  MA  01762 


1  Commander 

US  Army  Tank  Automotive  Rsch 
and  Development  Command 
ATTN:  AMSTA-TSL 
Warren,  MI  48090 

1  Commander 

US  Army  Foreign  Science  and 
Technology  Center 
ATTN:  Rsch  A  Cncepts  Br 
220  7th  Street  ,  NE 
Charlottesville,  VA  22901 


242 


DISTRIBUTION  LIST 


No.  Of  No*  of 

Copies  Organization  Copies  Organ  izay^on 


1  Commander 

US  Army  Logistics  Management 
Ctr 

ATTN:  ATCL-0 

Mr.  Robert  Cameron 
Fort  Lee,  VA  23801 

3  Commander 

US  Army  Materials  and 

Mechanics  Research  Center 
ATTN:  Technical  Library 

DRXMR-ER,  Joe  Prifti 
Eugene  de  Luca 
Watertown,  MA  02172 

1  Commander 

US  Army  Research  Office 
P.0.  Box  12211 
Research  Triangle  Park 
NC  27709-2211 

4  Commander 

US  Army  Nuclear  &  Chemical 
Agency 

ATTN:  ACTA-NAW 
MONA -WE 

Technical  Library 
LTC  Finno 

7500  Backlick  Rd,  Bldg.  2073 
Springfield,  VA  22150 

1  Commander 

US  Army  TRAD0C 

ATTN:  DCST&E 

Fort  Monroe,  VA  23651 

2  Director 

US  Army  TRAD0C  Systems 
Analysis  Activity 
ATTN:  LTC  John  Hesse 
ATAA-SL 

White  Sands  Missile  Range 
NM  8802 


1  Commander 

US  Combined  Arms  Combat 
Developments  Activity 
ATTN:  ATCA-C0, 

Mr.  L.  C.  Pleger 
Fort  Leavenworth,  KS  66027 

1  Commandant 

US  Army  Infantry  School 
ATTN:  ATSH-CD-CS0-0R 
Fort  Benning,  GA  31905 

1  Commander 

US  Army  Development  & 

Employment  Agency 
ATTN:  M0DE-TED-SAB 
Fort  Lewis,  WA  98433 

1  Commandant 

Interservice  Nuclear  Weapons 
School 

ATTN:  Technical  Library 
Kirtland  AFB,  NM  87115 

1  Chief  of  Naval  Material 
ATTN:  MAT  0323 
Department  of  the  Navy 
Arlington,  VA  22217 

2  Chief  of  Naval  Operations 
ATTN:  0P-03EG 

0P-985F 

Department  of  the  Navy 
Washington,  DC  20350 

1  Chief  of  Naval  Research 
ATTN:  N.  Perrone 
Department  of  the  Navy 
Arlington,  VA  22217 

1  Director 

Strategic  Systems  Projects  Ofc 
ATTN:  NSP-43,  Tech  Library 
Department  of  the  Navy 
Washington,  DC  20360 


DISTRIBUTION  LIST 


No.  of  No.  of 

Copies  Organization  Copies  Organization 


1  FTD/NIIS 

Wright-Patterson  AFB 
Ohio  45433 

1  Director 

Lawrence  Livermore  Lab. 

ATTN:  Tech  Info  Dept  L-3 
P.0.  Box  808 
Livermore,  CA  94550 

2  Director 

Los  Alamos  Scientific  Lab. 
ATTN:  Doc  Control  for  Rpts 
Lib 

P.0.  Box  1663 

Los  Alamos,  NM  87544 

2  Director 

Sandia  Laboratories 
ATTN:  Doc  Control  for  3141 

Sandia  Rpt  Collection 
L.  J.  Vortman 
Albuquerque,  NM  87115 

1  Director 

Sandia  Laboratories 
Livermore  Laboratory 
ATTN:  Doc  Control  for  Tech 
Lib 

P.0.  Box  969 
Livermore,  CA  94550 

1  Director 

National  Aeronautics  and 
Space  Administration 
Scientific  &  Tech  Info  Fac 
P.0.  Box  8757 
Baltimore /Washington 
International  Airport 
MD  21240 

1  Aerospace  Corporation 

A1TN:  Tech  Info  Services 

P.0.  Box  92957 

Los  Angeles,  CA  90009 


1  Agbabian  Associates 
ATTN:  M.  Agbabian 
250  North  Nash  Street 
El  Segundo,  CA  90245 

1  The  BDM  Corporation 
ATTN:  Richard  Hensley 
P.0.  Box  9274 
Albuquerque  International 
Albuquerque,  NM  87119 

1  The  Boeing  Company 
ATTN:  Aerospace  Library 
P.0.  Box  3707 
Seattle,  WA  98124 

2  California  Research 

and  Technology 
ATTN:  M.  Rosenblatt 
F.  Sauer 
Suite  B  130 
11875  Dublin  Blvd 
Dublin,  CA  94568 

1  Carpenter  Research  Corporation 
ATTN:  H.  Jerry  Carpenter 
6230  Scotmist  Drive 
Rancho  Palos  Verdes,  CA  90274 

1  Goodyear  Aerospace  Corp 
ATTN:  R.  M.  Brown,  Bldg  1 

Shelter  Engineering 
Litchfield  Park,  AZ  85340 

1  Director 

Inst  for  Defense  Analyses 
ATTN:  Library 
1801  Beauregard  St. 

Alexandria,  VA  22311 


244 


distribution  list 


No.  of 
Copies 


Organization 


No.  of 
Copies 


cvaan  ization 


Karoan  AviDyne  . 

ftTTN:  Or.  R.  Reutenick 

(4  cys) 

Mr.  S.  Criscione 
Mr.  R.  Milligan 
83  Second  Avenue 
Northwest  Industrial  ar 
Burlington,  MA  01830 

Kaman  Sciences  Corporation 

ATTN:  Library 

P.  A.  Ellis 
F.  H.  Shelton 

1500  Garden  of  the  Gods  Foa 
Colorado  Springs,  CO  809 

Science  Applications > 

ATTN:  Technical  Library 
1250  Prospect  Plaza 
'\  o  .Ini  la.  GA  92037 


McDonnell  Douglas  Astronautics 
Corporation 

ATTN:  Robert  W.  Halpr-ift 

K.A.  He  inly 
53OI  Bolsa  Avenue 
Huntington  Beach,  CA  i 

The  Mitre  Corporation 
ATTN:  Library 
P.0.  Box  208 
Bedford,  MA  0173 

New  Mexico  Engineering 
Research  Institute 
ATTN:  1.  Leigh 

P.0.  Box  25  UNM 

Albuquerque,  NM  7 
Physics  International  Corp 

2700  Merced  Street 
San  Leandro,  CA  94577 


1 


Kaman-TEMPO 

ATTN:  DASIAC 

p.0.  Drawer  QQ 
Santa  Barbara,  CA 


93102 


RAD  Associates 
ATTN:  Technical  Library 

Allan  Kuhl 

p.o.  Box  9895  _ 


Kaman-TEMPO 

ATTN:  E.  Bryant,  Suite  UL 

715  Shamrock  Road 


RCA  Government  Communications 


Systems 

} 3_5-2  Front  A  Cooper 
Camden,  NJ  O81O? 


Streets 


1 


Lockheed 

ATTN:  J 


Missiles  A  Space  Co 
.  J.  Murphy,  Dept. 
81-11,  Bldg.  154 


p.0.  Box  504 

Sunnyvale,  CA 


94086 


!  Martin  Marietta  Aerospace 
Orlando  Division 
ATTN:  G.  Fotieo 
P.0.  Box  5837 
Orlando,  EL  32805 


2  Science  Applications,  n- 
ATTN:  W.  Lay son 

John  Cockayne 

PO  BOX  13G* 

1710  Good ridge  Drive 
McLean,  VA  27107 


245 


s 

s 

js 

f  ■ 

L 


No.  of 

Copies  Organization 


DISTRIBUTION  LIST 
No.  of 

Copies  Organization 


2  Systems,  Science  and  Software  1 
ATTN:  C.  E.  Needham 

Lynn  Kennedy 
PO  Box  82 U  3 

Albuquerque,  NM  87198 

1 

3  Systems,  Science  and  Software 
ATTN:  Technical  Library 

R.  Duff 
K.  Pyatt 
PO  Box  1620 
La  Jolla,  CA  92037 

1  TRW  Electronics  &  Defense 
ATTN:  Benjamin  Sussholtz 
One  Space  Park 
Redondo  Beach,  CA  90278 


IIT  Research  Institute 
ATTN:  Milton  R.  Johnson 
10  West  35th  Street 
Chicago,  IL  60616 

TRW 

Ballistic  Missile  Division 
ATTN:  H.  Korman,  Mail  Station 
526/611) 

P.0.  Box  1310 
San  Bernardino,  CA  92402 

1  J.  D.  Haltiwanger 
Consulting  Services 
B106a  Civil  Engineering  Bldg. 
208  N.  Romine  Street 
Urbana,  IL  61801 


2  Union  Carbide  Corporation 

Holifield  National  Laboratory 
ATTN:  Doc  Control  for  Tech  Lib 
Civil  Defense  Research  Proj 
PO  Box  X 

Oak  Ridge,  TN  37830 

1  Weidlinger  Assoc.  Consulting 
Engineers 

110  East  59th  Street 
New  York,  NY  10022 

1  Battelle  Memorial  Institute 
ATTN:  Technical  Library 
505  King  Avenue 
Columbus,  OH  43201 

1  California  Inst  of  Tech 
ATTN:  T.  J.  Ahrens 
1201  E.  California  Blvd. 
Pasadena,  CA  91109 

2  Denver  Research  Institute 
University  of  Denver 
ATTN:  Mr.  J.  Wisotski 

Technical  Library 
P0  Box  10127 
Denver,  CO  80210 


1  Massachusetts  Institute  of 

Technology 

Aeroelastic  and  Structures 
Research  Laboratory 
ATTN:  Dr.  E.  A.  Witmer 
Cambridge,  MA  02139 

2  Southwest  Research  Institute 
ATTN:  Dr.  W.  E.  Baker 

A.  B.  Wenzel 
8500  Culebra  Road 
San  Antonio,  TX  78228 

1  SRI  International 
ATTN:  Dr.  G.  R. 

Abrahamson 

333  Ravenswood  Avenue 
Menlo  Park,  CA  94025 

1  Stanford  University 

ATTN:  Dr.  D.  Bershader 
Durand  Laboratory 
Stanford,  CA  94305 

1  Washington  State  University 
Physics  Department 
ATTN:  G.  R.  Fowles 
Pullman,  WA  99163 


24  6 


DISTRIBUTION  LIST 


Organization 


Aberdeen  Proving  Ground 

Dir,  USAMSAA 
ATTN:  AMXSY-D 

AMXSY-MP,  H.  Cohen 
Cdr ,  USATECOM 

ATTN :  AMSTE-TO-F 
Cdr,  CRDC,  AMCCOM 
ATTN :  SMCCR-RSP-A 
SMCCR-MD 
SMCCR-SPS-IL 


247 


USER  EVALUATION  SHEET/CHANGE  OF  ADDRESS 


This  Laboratory  undertakes  a  continuing  effort  to  improve  the  quality  of  the 
reports  it  publishes.  Your  comments/answers  to  the  items/questions  below  will 
aid  us  in  our  efforts. 

1.  BRL  Report  Number _ Date  of  Report _ 

2.  Date  Report  Received _ _ _ 


3.  Does  this  report  satisfy  a  need?  (Comment  on  purpose,  related  project,  or 
other  area  of  interest  for  which  the  report  will  be  used.) 


4.  How  specifically,  is  the  report  being  used?  (Information  source,  design 
data,  procedure,  source  of  ideas,  etc.) _ 


5.  Has  the  information  in  this  report  led  to  any  quantitative  savings  as  far 
as  man-hours  or  dollars  saved,  operating  costs  avoided  or  efficiencies  achieved 
etc?  If  so,  please  elaborate. _ 


6.  Genera]  Comments.  What  do  you  think  should  be  changed  to  improve  future 
reports?  (Indicate  changes  to  organization,  technical  content,  format,  etc.) 


Name 


CURRENT 

ADDRESS 


Organization 


Address 


City,  State,  Zip 

7.  If  indicating  a  Change  of  Address  or  Address  Correction,  please  provide  the 
New  or  Correct  Address  in  Block  6  above  and  the  Old  or  Incorrect  address  below. 


OLD 

ADDRESS 


Name 


Organization 


Address 


City,  State,  Zip 


(Remove  this  sheet  along  the  perforation,  fold  as  indicated,  sta>  e  a:  tape 
c 1 oscd ,  and  mai 1 . ) 


-  FOLD  HERE  - 


Director 

US  Army  Ballistic  Research  Laboratory 
ATTN:  AMXBR-OD-ST 

Aberdeen  Proving  Ground,  MD  21005-5066 


NO  POSTAGE 
NECESSARY 
IF  MAILED 
IN  THE 

UNITED  STATES 


OFFICIAL  BUSINESS 

PENALTY  FOB  PRIVATE  USE.  *300 


BUSINESS  REPLY  MAIL 

FIRST  CLASS  PERMIT  NO  12062  WASHINGTON, DC 
POSTAGE  WILL  BE  PAID  BY  DEPARTMENT  OF  THE  ARMY 


Director 

US  Army  Ballistic  Research  Laboratory 
ATTN:  AMXBR-OD-ST 

Aberdeen  Proving  Ground,  MD  21005-9989 


